EXAMEN_M5
Patricia López Sanz
2023-06-12
EXAMEN MÓDULO 5 - 2023
Carga de Librerías:
rm(list = ls())
suppressPackageStartupMessages({
library(tictoc)
library(flextable)
library(kableExtra)
library(missRanger)
library(doParallel)
library(dplyr)
library(dlookr)
library(SmartEDA)
library(ggplot2)
library(corrgram)
library(randomForest)
library(caret)
library(doParallel)
library(fastDummies)
library(patchwork)
library(gbm)
library(car)
library(data.table)
library(tidytable)
library(tibble)
library(DALEX)
library(data.table)
library(corrplot)
library(janitor)
library(inspectdf)
library(MASS)
library(ISLR)
library(skimr)
library(funModeling)# Útil para visualizaciones.
library(inspectdf) # Visualizaciones y estadística descriptiva.
library(DataExplorer) # Correlaciones, gráficas y tablas.
library(PerformanceAnalytics) # Correlaciones, gráficas y tablas.
library(corrplot) # Análisis de correlaciones.
library(mice)
# Para maquetar tablas y hacerlas más vistosas.
library(flextable)
library(kableExtra)
library(rmarkdown)
})Variables de la base de datos
-Lng : coordenada de longitud utilizando el protocolo BD09 -Lat : coordenada de latitud utilizando el protocolo BD09 -DOM : días activos en el mercado. Más información en https://en.wikipedia.org/wiki/Days_on_market -seguidores : el número de personas que siguen la transacción. -cuadrados : número total de metros. -salón : número de habitaciones. -drawingRoom : número de salones. -cocina : número de cocinas. -cuarto de baño : número de baños. -floor : el número total de pisos en el edificio. -buildingType : (tower) torre (1), bungalow (2), (combination of plate and tower), combinación de lámina y torre (3), (plate) lámina (4) -renovaciónCondición : Otros (1), ásperas (2), sencillez (3), duras (4) -buildingStructure : desconocida (1), mixta (2), ladrillo y madera (3), ladrillo y cemento (4), acero (5) acero y hormigón (6). -ladderRatio : Describa las escaleras que tiene un residente en promedio. -ascensor : tiene ascensor (1) no tiene ascensor (0) -fiveYearsProperty : si el dueño tiene la propiedad por menos de 5 años (1) en caso contrario (0) -metro : si está cerca del metro (1) en caso contario (0) -precio : precio por metro cuadrado en yuanes. -totalPrice : precio total en millones de yuanes.
MAPA DE PEKÍN
library(ggplot2)
load(file = "C:\\Users\\soho_\\Desktop\\DATOS_2ºTRIMESTRE\\M5\\2023_M5_examen_enunciado\\beijing_map.RData",verbose = TRUE)## Loading objects:
## beijingbeijing
Lectura de Datos:
datos<-read.csv("C:\\Users\\soho_\\Desktop\\DATOS_2ºTRIMESTRE\\M5\\2023_M5_examen_enunciado\\mercado_beijing_2017.csv")
str(datos)## 'data.frame': 7455 obs. of 19 variables:
## $ Lng : num 116 116 117 116 117 ...
## $ Lat : num 40.2 40.2 39.9 40.1 39.9 ...
## $ DOM : int 546 457 430 487 392 398 369 370 347 272 ...
## $ followers : int 6 4 3 52 222 207 73 26 114 81 ...
## $ square : num 77 147 143 282 112 ...
## $ livingRoom : int 2 3 1 5 3 2 3 4 3 1 ...
## $ drawingRoom : int 1 2 0 2 2 1 1 2 1 1 ...
## $ kitchen : int 1 1 0 1 1 1 1 1 1 1 ...
## $ bathRoom : int 1 2 0 3 1 1 1 2 1 1 ...
## $ floor : int 6 7 32 6 6 6 18 8 9 18 ...
## $ buildingType : int 4 4 1 4 4 NA 1 4 3 1 ...
## $ renovationCondition: int 1 4 3 3 2 2 3 3 4 4 ...
## $ buildingStructure : int 2 2 6 2 2 1 6 6 6 6 ...
## $ ladderRatio : num 0.333 0.5 0.5 0.5 0.5 0.25 0.333 0.333 0.333 0.5 ...
## $ elevator : int 0 0 1 0 0 0 1 1 1 1 ...
## $ fiveYearsProperty : int 1 1 1 1 1 0 0 0 1 0 ...
## $ subway : int 0 0 1 0 1 1 0 1 1 0 ...
## $ price : int 22078 24507 32794 20579 29483 24649 63628 76198 61186 43279 ...
## $ totalPrice : num 170 360 470 580 330 200 649 1300 826 264 ...RENOMBRAMOS LAS VARIABLES PARA UN MEJOR ENTENDIMIENTO
names(datos)<-c("Lng","Lat","DOM","seguidores","cuadrados","salon","drawingRoom","cocina","cuartodebaño","floor","buildingType","renovacionCondicion","buildingStrucuture", "ladderRatio","ascensor","fiveYearsProperty","metro","precio","totalPrice")head(datos)| Lng | Lat | DOM | seguidores | cuadrados | salon | drawingRoom | cocina | cuartodebaño | floor | buildingType | renovacionCondicion | buildingStrucuture | ladderRatio | ascensor | fiveYearsProperty | metro | precio | totalPrice |
|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|
| 116.2324 | 40.23553 | 546 | 6 | 77.00 | 2 | 1 | 1 | 1 | 6 | 4 | 1 | 2 | 0.333 | 0 | 1 | 0 | 22078 | 170 |
| 116.2495 | 40.22179 | 457 | 4 | 146.90 | 3 | 2 | 1 | 2 | 7 | 4 | 4 | 2 | 0.500 | 0 | 1 | 0 | 24507 | 360 |
| 116.5239 | 39.92328 | 430 | 3 | 143.32 | 1 | 0 | 0 | 0 | 32 | 1 | 3 | 6 | 0.500 | 1 | 1 | 1 | 32794 | 470 |
| 116.4300 | 40.06624 | 487 | 52 | 281.85 | 5 | 2 | 1 | 3 | 6 | 4 | 3 | 2 | 0.500 | 0 | 1 | 0 | 20579 | 580 |
| 116.5209 | 39.91885 | 392 | 222 | 111.93 | 3 | 2 | 1 | 1 | 6 | 4 | 2 | 2 | 0.500 | 0 | 1 | 1 | 29483 | 330 |
| 116.2258 | 39.80226 | 398 | 207 | 81.14 | 2 | 1 | 1 | 1 | 6 | NA | 2 | 1 | 0.250 | 0 | 0 | 1 | 24649 | 200 |
summary(datos)## Lng Lat DOM seguidores
## Min. :116.1 Min. :39.63 Min. : 1.00 Min. : 0.00
## 1st Qu.:116.3 1st Qu.:39.89 1st Qu.: 1.00 1st Qu.: 1.00
## Median :116.4 Median :39.93 Median : 1.00 Median : 5.00
## Mean :116.4 Mean :39.94 Mean : 14.32 Mean : 14.48
## 3rd Qu.:116.5 3rd Qu.:39.99 3rd Qu.: 5.00 3rd Qu.: 17.00
## Max. :116.7 Max. :40.25 Max. :1352.00 Max. :580.00
##
## cuadrados salon drawingRoom cocina
## Min. : 6.90 Min. :0.000 Min. :0.000 Min. :0.0000
## 1st Qu.: 56.77 1st Qu.:1.000 1st Qu.:1.000 1st Qu.:1.0000
## Median : 76.90 Median :2.000 Median :1.000 Median :1.0000
## Mean : 85.39 Mean :1.919 Mean :1.111 Mean :0.9862
## 3rd Qu.:100.17 3rd Qu.:2.000 3rd Qu.:1.000 3rd Qu.:1.0000
## Max. :922.70 Max. :7.000 Max. :3.000 Max. :4.0000
##
## cuartodebaño floor buildingType renovacionCondicion
## Min. :0.0 Min. : 1.00 Min. :1.000 Min. :1.000
## 1st Qu.:1.0 1st Qu.: 6.00 1st Qu.:1.000 1st Qu.:1.000
## Median :1.0 Median :16.00 Median :3.000 Median :3.000
## Mean :1.2 Mean :15.88 Mean :2.707 Mean :2.849
## 3rd Qu.:1.0 3rd Qu.:22.00 3rd Qu.:4.000 3rd Qu.:4.000
## Max. :6.0 Max. :42.00 Max. :4.000 Max. :4.000
## NA's :316
## buildingStrucuture ladderRatio ascensor fiveYearsProperty
## Min. :1.000 Min. : 0.0200 Min. :0.000 Min. :0.0000
## 1st Qu.:2.000 1st Qu.: 0.2500 1st Qu.:0.000 1st Qu.:0.0000
## Median :6.000 Median : 0.3330 Median :1.000 Median :1.0000
## Mean :4.878 Mean : 0.3604 Mean :0.692 Mean :0.5545
## 3rd Qu.:6.000 3rd Qu.: 0.5000 3rd Qu.:1.000 3rd Qu.:1.0000
## Max. :6.000 Max. :10.0000 Max. :1.000 Max. :1.0000
##
## metro precio totalPrice
## Min. :0.0000 Min. : 2 Min. : 0.1
## 1st Qu.:0.0000 1st Qu.: 28993 1st Qu.: 205.0
## Median :1.0000 Median : 39362 Median : 305.0
## Mean :0.5958 Mean : 44911 Mean : 368.8
## 3rd Qu.:1.0000 3rd Qu.: 55222 3rd Qu.: 445.0
## Max. :1.0000 Max. :156250 Max. :4650.0
## ##VEMOS QUE MÁS DE UNA VARIABLE SE PUEDE PASAR A FACTOR PARA TRABAJAR CON SUS DATOS:
datos$buildingType = as.factor(datos$buildingType)
datos$buildingStrucuture = as.factor(datos$buildingStrucuture)
datos$floor = as.factor(datos$floor)
datos$ascensor = as.factor(datos$ascensor)
datos$fiveYearsProperty = as.factor(datos$fiveYearsProperty)
datos$metro = as.factor(datos$metro)
datos$renovacionCondicion=as.factor(datos$renovacionCondicion)##COMPROBAMOS LOS CAMBIOS:
str(datos)## 'data.frame': 7455 obs. of 19 variables:
## $ Lng : num 116 116 117 116 117 ...
## $ Lat : num 40.2 40.2 39.9 40.1 39.9 ...
## $ DOM : int 546 457 430 487 392 398 369 370 347 272 ...
## $ seguidores : int 6 4 3 52 222 207 73 26 114 81 ...
## $ cuadrados : num 77 147 143 282 112 ...
## $ salon : int 2 3 1 5 3 2 3 4 3 1 ...
## $ drawingRoom : int 1 2 0 2 2 1 1 2 1 1 ...
## $ cocina : int 1 1 0 1 1 1 1 1 1 1 ...
## $ cuartodebaño : int 1 2 0 3 1 1 1 2 1 1 ...
## $ floor : Factor w/ 37 levels "1","2","3","4",..: 6 7 32 6 6 6 18 8 9 18 ...
## $ buildingType : Factor w/ 4 levels "1","2","3","4": 4 4 1 4 4 NA 1 4 3 1 ...
## $ renovacionCondicion: Factor w/ 4 levels "1","2","3","4": 1 4 3 3 2 2 3 3 4 4 ...
## $ buildingStrucuture : Factor w/ 6 levels "1","2","3","4",..: 2 2 6 2 2 1 6 6 6 6 ...
## $ ladderRatio : num 0.333 0.5 0.5 0.5 0.5 0.25 0.333 0.333 0.333 0.5 ...
## $ ascensor : Factor w/ 2 levels "0","1": 1 1 2 1 1 1 2 2 2 2 ...
## $ fiveYearsProperty : Factor w/ 2 levels "0","1": 2 2 2 2 2 1 1 1 2 1 ...
## $ metro : Factor w/ 2 levels "0","1": 1 1 2 1 2 2 1 2 2 1 ...
## $ precio : int 22078 24507 32794 20579 29483 24649 63628 76198 61186 43279 ...
## $ totalPrice : num 170 360 470 580 330 200 649 1300 826 264 ...Etapa EDA (Exploratory Data Analysis):
##VEMOS SI HAY ALGÚN DATO DUPLICADO
anyDuplicated(datos)## [1] 2779Vemos que hay 2779 inmuebles con las mismas características.
Vemos las distribuciones que tienen todas las variables:
skim(datos)| Name | datos |
| Number of rows | 7455 |
| Number of columns | 19 |
| _______________________ | |
| Column type frequency: | |
| factor | 7 |
| numeric | 12 |
| ________________________ | |
| Group variables | None |
Variable type: factor
| skim_variable | n_missing | complete_rate | ordered | n_unique | top_counts |
|---|---|---|---|---|---|
| floor | 0 | 1.00 | FALSE | 37 | 6: 1497, 22: 545, 16: 479, 18: 452 |
| buildingType | 316 | 0.96 | FALSE | 4 | 4: 2830, 1: 2448, 3: 1834, 2: 27 |
| renovacionCondicion | 0 | 1.00 | FALSE | 4 | 4: 3431, 1: 2186, 3: 1651, 2: 187 |
| buildingStrucuture | 0 | 1.00 | FALSE | 6 | 6: 5259, 2: 1783, 4: 222, 1: 113 |
| ascensor | 0 | 1.00 | FALSE | 2 | 1: 5159, 0: 2296 |
| fiveYearsProperty | 0 | 1.00 | FALSE | 2 | 1: 4134, 0: 3321 |
| metro | 0 | 1.00 | FALSE | 2 | 1: 4442, 0: 3013 |
Variable type: numeric
| skim_variable | n_missing | complete_rate | mean | sd | p0 | p25 | p50 | p75 | p100 | hist |
|---|---|---|---|---|---|---|---|---|---|---|
| Lng | 0 | 1 | 116.42 | 0.12 | 116.07 | 116.34 | 116.42 | 116.48 | 116.73 | ▁▃▇▃▂ |
| Lat | 0 | 1 | 39.94 | 0.10 | 39.63 | 39.89 | 39.93 | 39.99 | 40.25 | ▁▂▇▂▁ |
| DOM | 0 | 1 | 14.32 | 39.48 | 1.00 | 1.00 | 1.00 | 5.00 | 1352.00 | ▇▁▁▁▁ |
| seguidores | 0 | 1 | 14.48 | 27.54 | 0.00 | 1.00 | 5.00 | 17.00 | 580.00 | ▇▁▁▁▁ |
| cuadrados | 0 | 1 | 85.39 | 44.56 | 6.90 | 56.76 | 76.90 | 100.17 | 922.70 | ▇▁▁▁▁ |
| salon | 0 | 1 | 1.92 | 0.84 | 0.00 | 1.00 | 2.00 | 2.00 | 7.00 | ▆▇▃▁▁ |
| drawingRoom | 0 | 1 | 1.11 | 0.61 | 0.00 | 1.00 | 1.00 | 1.00 | 3.00 | ▂▇▁▃▁ |
| cocina | 0 | 1 | 0.99 | 0.16 | 0.00 | 1.00 | 1.00 | 1.00 | 4.00 | ▁▇▁▁▁ |
| cuartodebaño | 0 | 1 | 1.20 | 0.50 | 0.00 | 1.00 | 1.00 | 1.00 | 6.00 | ▇▂▁▁▁ |
| ladderRatio | 0 | 1 | 0.36 | 0.21 | 0.02 | 0.25 | 0.33 | 0.50 | 10.00 | ▇▁▁▁▁ |
| precio | 0 | 1 | 44911.28 | 23004.78 | 2.00 | 28992.50 | 39362.00 | 55221.50 | 156250.00 | ▅▇▂▁▁ |
| totalPrice | 0 | 1 | 368.75 | 270.45 | 0.10 | 205.00 | 305.00 | 445.00 | 4650.00 | ▇▁▁▁▁ |
VARIABLE OBJETIVO: “PRECIO TOTAL”
beijing + geom_point(data = datos, aes(datos$Lng, datos$Lat,color=totalPrice),size=1.3,alpha=1)+theme(axis.title= element_blank(), axis.text =element_blank()) ## Warning: Use of `datos$Lng` is discouraged.
## ℹ Use `Lng` instead.## Warning: Use of `datos$Lat` is discouraged.
## ℹ Use `Lat` instead.
Vemos cómo se distribuye el precio por toda la ciudad de Beijing. Los precios más altos están en el centro de la ciudad.
Análisis de variables numéricas:
profiling_num(datos)| variable | mean | std_dev | variation_coef | p_01 | p_05 | p_25 | p_50 | p_75 | p_95 | p_99 | skewness | kurtosis | iqr | range_98 | range_80 |
|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|
| Lng | 1.164173e+02 | 1.234120e-01 | 0.0010601 | 116.14757 | 116.21267 | 116.33695 | 116.41683 | 116.48333 | 116.65546 | 116.69365 | 0.3069222 | 2.973006 | 1.46386e-01 | [116.147569, 116.693646] | [116.262442, 116.629641] |
| Lat | 3.994473e+01 | 9.658310e-02 | 0.0024179 | 39.68235 | 39.79942 | 39.89359 | 39.93125 | 39.98763 | 40.09208 | 40.22928 | 0.3120597 | 4.536694 | 9.40335e-02 | [39.682354, 40.22927972] | [39.860989, 40.073376] |
| DOM | 1.431925e+01 | 3.947815e+01 | 2.7569989 | 1.00000 | 1.00000 | 1.00000 | 1.00000 | 5.00000 | 84.00000 | 171.46000 | 9.0232783 | 204.412009 | 4.00000e+00 | [1, 171.46] | [1, 45] |
| seguidores | 1.448048e+01 | 2.754146e+01 | 1.9019710 | 0.00000 | 0.00000 | 1.00000 | 5.00000 | 17.00000 | 61.00000 | 122.46000 | 5.8408133 | 65.796789 | 1.60000e+01 | [0, 122.46] | [0, 39] |
| cuadrados | 8.539014e+01 | 4.456307e+01 | 0.5218761 | 21.97580 | 40.20000 | 56.76500 | 76.90000 | 100.17000 | 160.00000 | 238.26580 | 3.2253540 | 31.218939 | 4.34050e+01 | [21.9758, 238.2658] | [44.75, 136.936] |
| salon | 1.918578e+00 | 8.368025e-01 | 0.4361576 | 1.00000 | 1.00000 | 1.00000 | 2.00000 | 2.00000 | 3.00000 | 4.00000 | 0.7981723 | 4.017120 | 1.00000e+00 | [1, 4] | [1, 3] |
| drawingRoom | 1.110798e+00 | 6.070068e-01 | 0.5464601 | 0.00000 | 0.00000 | 1.00000 | 1.00000 | 1.00000 | 2.00000 | 2.00000 | 0.0137641 | 2.830933 | 0.00000e+00 | [0, 2] | [0, 2] |
| cocina | 9.861838e-01 | 1.586335e-01 | 0.1608560 | 0.00000 | 1.00000 | 1.00000 | 1.00000 | 1.00000 | 1.00000 | 1.00000 | -2.1914878 | 57.033985 | 0.00000e+00 | [0, 1] | [1, 1] |
| cuartodebaño | 1.200000e+00 | 5.017811e-01 | 0.4181509 | 0.00000 | 1.00000 | 1.00000 | 1.00000 | 1.00000 | 2.00000 | 3.00000 | 2.2038069 | 11.209694 | 0.00000e+00 | [0, 3] | [1, 2] |
| ladderRatio | 3.603976e-01 | 2.123318e-01 | 0.5891600 | 0.06100 | 0.14300 | 0.25000 | 0.33300 | 0.50000 | 0.66700 | 1.00000 | 13.5628601 | 574.793945 | 2.50000e-01 | [0.061, 1] | [0.167, 0.5] |
| precio | 4.491128e+04 | 2.300478e+04 | 0.5122271 | 13068.10000 | 19154.50000 | 28992.50000 | 39362.00000 | 55221.50000 | 90717.40000 | 124896.86000 | 1.4205350 | 5.587178 | 2.62290e+04 | [13068.1, 124896.86] | [22046, 75214.2] |
| totalPrice | 3.687540e+02 | 2.704459e+02 | 0.7334046 | 80.00000 | 120.00000 | 205.00000 | 305.00000 | 445.00000 | 826.60000 | 1350.00000 | 3.9412867 | 36.415539 | 2.40000e+02 | [80, 1350] | [147.24, 656.6] |
# Graficamos las distibuciones de las variables numéricas
plot_num(datos)## Warning: The `<scale>` argument of `guides()` cannot be `FALSE`. Use "none" instead as
## of ggplot2 3.3.4.
## ℹ The deprecated feature was likely used in the funModeling package.
## Please report the issue at <https://github.com/pablo14/funModeling/issues>.
## This warning is displayed once every 8 hours.
## Call `lifecycle::last_lifecycle_warnings()` to see where this warning was
## generated.
mean(datos$precio)## [1] 44911.28mean(datos$totalPrice)## [1] 368.754mean(datos$cuadrados)## [1] 85.39014Vemos que el precio medio por metro cuadrado es de 44911.28 yenes. Y el precio medio por piso es aproximadamente 369 millones de yenes.
El tamaño medio de los pisos es de 85 metros cuadrados.
##TRANSFORMAMOS CON LOGARTIMOS LAS TRES VARIABLES QUE PRESENTAN UNA DISTRIBUCIÓN SESGADA HACIA LA IZQUIERDA:
datos$cuadrados1<-log(datos$cuadrados)
datos$precio1<-log(datos$precio)
datos$totalPrice1<-log(datos$totalPrice)
plot_num(datos)
ggplot(datos, aes(precio1)) + geom_histogram(bins=100)
ggplot(datos, aes(totalPrice1)) + geom_histogram(bins=100)
ggplot(datos, aes(cuadrados1)) + geom_histogram(bins=100)
ggplot(datos, aes(seguidores)) + geom_histogram(bins=100)
ggplot(datos, aes(ladderRatio)) + geom_histogram(bins=100)
ggplot(datos, aes(DOM)) + geom_histogram(bins=100)
VEMOS QUE QUEDA MUY MEJORADA LA DISTRIBUCIÓN DE LAS VARIABLES TRANSFORMADAS CON LOGARITMOS.
TAMBIÉN VEMOS QUE LAS VARIABLES: “DOM” Y “SEGUIDORES” TIENEN MUCHOS VALORES PEQUEÑOS CERCA DEL CERO. CON LO QUE A LO MEJOR NO CONTAMOS CON ELLAS A LA HORA DE HACER EL ESTUDIO Y EL MODELO. TODO PARECE INDICAR QUE SEAN ERRORES EN LA INTRODUCCIÓN DE DATOS, O TRANSFORMACIONES A CERO DE TODOS LOS VALORES MISSING.
#COMPROBAMOS LOS DATOS DE "DOM":
kable(datos %>% group_by(DOM) %>% summarise(count=n()))| DOM | count |
|---|---|
| 1 | 5320 |
| 2 | 93 |
| 3 | 59 |
| 4 | 58 |
| 5 | 66 |
| 6 | 48 |
| 7 | 56 |
| 8 | 37 |
| 9 | 44 |
| 10 | 55 |
| 11 | 58 |
| 12 | 41 |
| 13 | 32 |
| 14 | 38 |
| 15 | 35 |
| 16 | 35 |
| 17 | 36 |
| 18 | 30 |
| 19 | 38 |
| 20 | 29 |
| 21 | 34 |
| 22 | 25 |
| 23 | 28 |
| 24 | 41 |
| 25 | 28 |
| 26 | 28 |
| 27 | 21 |
| 28 | 16 |
| 29 | 17 |
| 30 | 20 |
| 31 | 23 |
| 32 | 18 |
| 33 | 28 |
| 34 | 19 |
| 35 | 19 |
| 36 | 25 |
| 37 | 18 |
| 38 | 21 |
| 39 | 13 |
| 40 | 11 |
| 41 | 12 |
| 42 | 15 |
| 43 | 9 |
| 44 | 9 |
| 45 | 13 |
| 46 | 14 |
| 47 | 10 |
| 48 | 14 |
| 49 | 11 |
| 50 | 12 |
| 51 | 10 |
| 52 | 9 |
| 53 | 10 |
| 54 | 11 |
| 55 | 13 |
| 56 | 12 |
| 57 | 10 |
| 58 | 9 |
| 59 | 11 |
| 60 | 15 |
| 61 | 11 |
| 62 | 9 |
| 63 | 9 |
| 64 | 9 |
| 65 | 5 |
| 66 | 11 |
| 67 | 9 |
| 68 | 7 |
| 69 | 9 |
| 70 | 6 |
| 71 | 12 |
| 72 | 10 |
| 73 | 8 |
| 74 | 4 |
| 75 | 6 |
| 76 | 7 |
| 77 | 12 |
| 78 | 7 |
| 79 | 6 |
| 80 | 8 |
| 81 | 10 |
| 82 | 5 |
| 83 | 8 |
| 84 | 5 |
| 85 | 5 |
| 86 | 7 |
| 87 | 9 |
| 88 | 8 |
| 89 | 8 |
| 90 | 2 |
| 91 | 8 |
| 92 | 8 |
| 93 | 6 |
| 94 | 7 |
| 95 | 6 |
| 96 | 7 |
| 97 | 1 |
| 98 | 6 |
| 99 | 4 |
| 100 | 8 |
| 101 | 9 |
| 102 | 3 |
| 103 | 3 |
| 104 | 5 |
| 105 | 6 |
| 106 | 2 |
| 107 | 4 |
| 108 | 4 |
| 109 | 3 |
| 110 | 5 |
| 111 | 2 |
| 112 | 1 |
| 113 | 8 |
| 114 | 3 |
| 115 | 3 |
| 116 | 1 |
| 117 | 2 |
| 118 | 4 |
| 119 | 3 |
| 120 | 4 |
| 121 | 2 |
| 122 | 3 |
| 124 | 4 |
| 125 | 3 |
| 126 | 2 |
| 127 | 8 |
| 128 | 5 |
| 129 | 6 |
| 130 | 6 |
| 131 | 5 |
| 132 | 3 |
| 133 | 2 |
| 134 | 3 |
| 135 | 3 |
| 136 | 2 |
| 138 | 3 |
| 139 | 3 |
| 140 | 2 |
| 141 | 1 |
| 142 | 2 |
| 143 | 3 |
| 144 | 2 |
| 145 | 1 |
| 146 | 5 |
| 147 | 5 |
| 148 | 1 |
| 149 | 2 |
| 150 | 3 |
| 151 | 1 |
| 152 | 2 |
| 153 | 2 |
| 155 | 2 |
| 156 | 1 |
| 157 | 2 |
| 158 | 2 |
| 159 | 1 |
| 160 | 2 |
| 161 | 1 |
| 162 | 1 |
| 164 | 3 |
| 166 | 4 |
| 167 | 1 |
| 168 | 1 |
| 169 | 2 |
| 170 | 1 |
| 171 | 3 |
| 172 | 1 |
| 174 | 3 |
| 175 | 1 |
| 176 | 1 |
| 177 | 2 |
| 179 | 1 |
| 180 | 1 |
| 182 | 2 |
| 184 | 1 |
| 186 | 1 |
| 187 | 1 |
| 188 | 2 |
| 191 | 1 |
| 193 | 1 |
| 196 | 2 |
| 197 | 3 |
| 198 | 1 |
| 200 | 1 |
| 201 | 2 |
| 206 | 2 |
| 207 | 1 |
| 208 | 1 |
| 209 | 2 |
| 210 | 1 |
| 211 | 1 |
| 213 | 2 |
| 215 | 1 |
| 217 | 1 |
| 223 | 1 |
| 224 | 1 |
| 232 | 1 |
| 235 | 2 |
| 237 | 1 |
| 238 | 1 |
| 241 | 1 |
| 253 | 1 |
| 254 | 1 |
| 260 | 1 |
| 261 | 1 |
| 263 | 2 |
| 269 | 1 |
| 270 | 1 |
| 271 | 1 |
| 272 | 1 |
| 276 | 1 |
| 281 | 1 |
| 295 | 1 |
| 297 | 1 |
| 312 | 1 |
| 340 | 1 |
| 347 | 1 |
| 369 | 1 |
| 370 | 1 |
| 392 | 1 |
| 398 | 1 |
| 414 | 1 |
| 430 | 1 |
| 457 | 1 |
| 487 | 1 |
| 546 | 1 |
| 1352 | 1 |
AQUÍ QUEDA COMPROBADO QUE 5320 DATOS DE 7455, SON “1”. ESTA VARIABLE LA QUITAREMOS DEL MODELO, YA QUE NO INTERESA PORQUE NO EXPLICA ENTONCES. SEA POR CUESTIONES DE BREVE DURACIÓN EN EL MERCADO (PARECE QUE PODRÍA SER LA RAZÓN MÁS VIABLE), O DE QUE HAYAN IMPUTADO NA´S AL VALOR DE 1, QUE NO CREO.
#COMPROBAMOS LOS DATOS DE "SEGUIDORES":
kable(datos %>% group_by(seguidores) %>% summarise(count=n()))| seguidores | count |
|---|---|
| 0 | 1719 |
| 1 | 646 |
| 2 | 480 |
| 3 | 371 |
| 4 | 368 |
| 5 | 281 |
| 6 | 239 |
| 7 | 215 |
| 8 | 214 |
| 9 | 178 |
| 10 | 143 |
| 11 | 152 |
| 12 | 132 |
| 13 | 111 |
| 14 | 123 |
| 15 | 110 |
| 16 | 107 |
| 17 | 106 |
| 18 | 94 |
| 19 | 79 |
| 20 | 68 |
| 21 | 67 |
| 22 | 75 |
| 23 | 60 |
| 24 | 65 |
| 25 | 61 |
| 26 | 43 |
| 27 | 46 |
| 28 | 44 |
| 29 | 35 |
| 30 | 36 |
| 31 | 33 |
| 32 | 23 |
| 33 | 37 |
| 34 | 30 |
| 35 | 25 |
| 36 | 26 |
| 37 | 26 |
| 38 | 33 |
| 39 | 29 |
| 40 | 25 |
| 41 | 25 |
| 42 | 25 |
| 43 | 27 |
| 44 | 16 |
| 45 | 18 |
| 46 | 27 |
| 47 | 15 |
| 48 | 12 |
| 49 | 19 |
| 50 | 12 |
| 51 | 18 |
| 52 | 7 |
| 53 | 8 |
| 54 | 9 |
| 55 | 13 |
| 56 | 16 |
| 57 | 9 |
| 58 | 13 |
| 59 | 19 |
| 60 | 13 |
| 61 | 15 |
| 62 | 15 |
| 63 | 9 |
| 64 | 8 |
| 65 | 9 |
| 66 | 7 |
| 67 | 6 |
| 68 | 7 |
| 69 | 10 |
| 70 | 5 |
| 71 | 4 |
| 72 | 9 |
| 73 | 8 |
| 74 | 12 |
| 75 | 11 |
| 76 | 5 |
| 77 | 5 |
| 78 | 3 |
| 79 | 6 |
| 80 | 6 |
| 81 | 9 |
| 82 | 5 |
| 83 | 5 |
| 84 | 3 |
| 85 | 8 |
| 86 | 3 |
| 87 | 5 |
| 88 | 3 |
| 89 | 4 |
| 90 | 5 |
| 91 | 7 |
| 92 | 3 |
| 93 | 3 |
| 94 | 3 |
| 95 | 2 |
| 96 | 4 |
| 97 | 3 |
| 98 | 8 |
| 99 | 3 |
| 100 | 3 |
| 101 | 4 |
| 102 | 4 |
| 103 | 1 |
| 104 | 2 |
| 105 | 6 |
| 106 | 3 |
| 107 | 2 |
| 108 | 1 |
| 109 | 2 |
| 110 | 4 |
| 112 | 4 |
| 114 | 4 |
| 115 | 2 |
| 116 | 1 |
| 117 | 5 |
| 119 | 2 |
| 120 | 2 |
| 121 | 5 |
| 122 | 1 |
| 123 | 3 |
| 126 | 4 |
| 127 | 1 |
| 129 | 1 |
| 130 | 1 |
| 131 | 2 |
| 132 | 3 |
| 133 | 3 |
| 134 | 1 |
| 137 | 1 |
| 138 | 1 |
| 139 | 1 |
| 140 | 2 |
| 142 | 5 |
| 147 | 1 |
| 148 | 1 |
| 149 | 1 |
| 150 | 1 |
| 151 | 1 |
| 152 | 1 |
| 153 | 1 |
| 155 | 3 |
| 158 | 1 |
| 162 | 1 |
| 166 | 1 |
| 167 | 1 |
| 176 | 1 |
| 182 | 1 |
| 183 | 2 |
| 186 | 1 |
| 188 | 1 |
| 189 | 2 |
| 195 | 2 |
| 197 | 1 |
| 200 | 1 |
| 202 | 1 |
| 207 | 1 |
| 212 | 1 |
| 220 | 1 |
| 221 | 1 |
| 222 | 1 |
| 231 | 1 |
| 240 | 1 |
| 242 | 1 |
| 266 | 1 |
| 274 | 1 |
| 306 | 1 |
| 308 | 1 |
| 315 | 1 |
| 343 | 1 |
| 361 | 1 |
| 396 | 1 |
| 414 | 1 |
| 417 | 1 |
| 580 | 1 |
CON ESTA VARIABLE LO QUE SUCEDE ES QUE TIENE MUCHOS VALORES PEQUEÑOS, PERO SE VE QUE NO ES UN ERROR EN LA INTRODUCIÓN DE DATOS. SOLAMENTE SIGNIFICA, QUE LA MAYORÍA DE LAS VENTAS DURARON EN EL MERCADO MUY POCOS DÍAS, O SE VENDIÓ EN EL MISMO DÍA DE PONER EL ANUNCIO.
TRABAJAMOS CON LA NUEVA BASE DE DATOS: datos1 Quedándonos con las variables transformadas anteriormente.
datos1<-datos[,-c(5,18,19)]
plot_num(datos1)
Nos quedan distribuciones más normalizadas.
Aunque la variable DOM sigue teniendo muchos CEROS, y tendríamos que averiguar si en Beijing la venta es fugaz en la ciudad. O si alguien transformó anteriormente todos los valores MISSING a unos.
Y vemos que los pisos que más abundan son con 1 cocina, 1 baño y 1 salón(drawingRoom), y 1 ó 2 habitaciones.
También se observa que la media de los metros cuadrados de los pisos, ronda los 85m2. Así que no se trata de apartamentos o estudios.
VEAMOS LA RELACIÓN QUE TIENEN NUESTRAS VARIABLES NUMÉRICAS CON LA VARIABLE OBJETIVO “TOTALPRICE”:
AHORA ESTUDIAMOS LAS VARIABLES CATEGÓRICAS:
freq(datos1)
## floor frequency percentage cumulative_perc
## 1 6 1497 20.08 20.08
## 2 22 545 7.31 27.39
## 3 16 479 6.43 33.82
## 4 18 452 6.06 39.88
## 5 24 409 5.49 45.37
## 6 21 399 5.35 50.72
## 7 28 289 3.88 54.60
## 8 12 238 3.19 57.79
## 9 15 232 3.11 60.90
## 10 20 228 3.06 63.96
## 11 5 219 2.94 66.90
## 12 27 215 2.88 69.78
## 13 26 198 2.66 72.44
## 14 25 191 2.56 75.00
## 15 11 190 2.55 77.55
## 16 10 175 2.35 79.90
## 17 9 169 2.27 82.17
## 18 7 167 2.24 84.41
## 19 14 139 1.86 86.27
## 20 17 110 1.48 87.75
## 21 13 108 1.45 89.20
## 22 30 107 1.44 90.64
## 23 1 99 1.33 91.97
## 24 23 94 1.26 93.23
## 25 34 92 1.23 94.46
## 26 29 75 1.01 95.47
## 27 8 72 0.97 96.44
## 28 31 54 0.72 97.16
## 29 4 53 0.71 97.87
## 30 19 51 0.68 98.55
## 31 3 45 0.60 99.15
## 32 2 21 0.28 99.43
## 33 32 16 0.21 99.64
## 34 33 12 0.16 99.80
## 35 42 8 0.11 99.91
## 36 37 4 0.05 99.96
## 37 36 3 0.04 100.00
## buildingType frequency percentage cumulative_perc
## 1 4 2830 37.96 37.96
## 2 1 2448 32.84 70.80
## 3 3 1834 24.60 95.40
## 4 <NA> 316 4.24 99.64
## 5 2 27 0.36 100.00
## renovacionCondicion frequency percentage cumulative_perc
## 1 4 3431 46.02 46.02
## 2 1 2186 29.32 75.34
## 3 3 1651 22.15 97.49
## 4 2 187 2.51 100.00
## buildingStrucuture frequency percentage cumulative_perc
## 1 6 5259 70.54 70.54
## 2 2 1783 23.92 94.46
## 3 4 222 2.98 97.44
## 4 1 113 1.52 98.96
## 5 3 73 0.98 99.94
## 6 5 5 0.07 100.00
## ascensor frequency percentage cumulative_perc
## 1 1 5159 69.2 69.2
## 2 0 2296 30.8 100.0
## fiveYearsProperty frequency percentage cumulative_perc
## 1 1 4134 55.45 55.45
## 2 0 3321 44.55 100.00
## metro frequency percentage cumulative_perc
## 1 1 4442 59.58 59.58
## 2 0 3013 40.42 100.00## [1] "Variables processed: floor, buildingType, renovacionCondicion, buildingStrucuture, ascensor, fiveYearsProperty, metro"**En primer lugar vemos que las alturas más vendidas son los pisos: 6ªplanta (una quinta parte del total de ventas-20%) y le siguen aunque con distancia los pisos 16ª,18ª,21ª, 22ª y 24ªplanta.
**Con respecto al tipo de estructura, se ve claramente que las mayores ventas, se dan en “lámina” y en “combinación de lamina y torre”, y lo que apenas se vende (no sabemos si porque este tipo de edificación no abunda en Beijing), son los “bungalows”.
**Y con respecto a la condición de reforma del piso, vemos que abundan las ventas que han tenido una alta-reforma, con casi un 46% de las ventas.
**En el material de la estructura del edificio, arrasan por encima del resto las construcciones con “acero y hormigón” con más de un 70% de las ventas. Y vemos como el material de madera apenas es utilizado, lo que cuadra perfectamente con la poca construcción de bungalows.
**Como cabía de esperar, las ventas de edificios con ascensor superan con creces a los que no disponen de este servicio. Siendo las ventas con ascensor del 70% frente al 30% sin ascensor.
**Respecto a la antiguedad del edificio, priman las ventas de edificios en las que el dueño las ha adquirido hace menos de 5 años. Pero tampoco hay una distancia tan grande con respecto a las ventas que no cumplen esto.
**El metro de una ciudad tan grande siempre va a ser un reclamo para darle categoría al piso que está en venta, y claramente se ve que el número total de ventas de los pisos que están cerca a ellos es mayor con el 60% de las ventas frente al 40% de los que no tienen este servicio de transporte cerca.
#DISTRIBUCIÓN DE LA VARIABLE "FLOOR" EN LA CIUDAD:
beijing + geom_point(data = datos, aes(Lng, Lat, color = floor),size=1.3,alpha=1) +theme(axis.title= element_blank(), axis.text =element_blank())
Vemos que los edificios más altos, con más de 30 plantas están también en el centro.
#DISTRIBUCIÓN DE LA VARIABLE "TIPO DE CONSTRUCCIÓN" EN LA CIUDAD:
beijing + geom_point(data = datos, aes(Lng, Lat, color = buildingType),size=1.3,alpha=1) +theme(axis.title= element_blank(), axis.text =element_blank())
Vemos que apenas hay bungalows en la ciudad.
#DISTRIBUCIÓN DE LA VARIABLE "CONDICIÓN DE RENOVACIÓN" EN LA CIUDAD:
beijing + geom_point(data = datos, aes(Lng, Lat, color = renovacionCondicion),size=1.3,alpha=1) +theme(axis.title= element_blank(), axis.text =element_blank())
Están bastante repartidas por toda la ciudad, no parece que dependa tanto de la ubicación.
#DISTRIBUCIÓN DE LA VARIABLE "ESTRUCTURA" EN LA CIUDAD:
beijing + geom_point(data = datos, aes(Lng, Lat, color = buildingStrucuture),size=1.3,alpha=1) +theme(axis.title= element_blank(), axis.text =element_blank())
Los únicos edificios hechos en madera, que serán bungalows están todos en el centro de la ciudad. Suponemos que será la parte antigua de la ciudad.
#DISTRIBUCIÓN DE LA VARIABLE "CONDICIÓN DE REFORMA" EN LA CIUDAD:
beijing + geom_point(data = datos, aes(Lng, Lat, color = renovacionCondicion),size=1.3,alpha=1) +theme(axis.title= element_blank(), axis.text =element_blank())
Las reformas que tienen los inmuebles no dependen tanto de la ubicación, está bastante repartido.
#DISTRIBUCIÓN DE LA VARIABLE "ASCENSOR" EN LA CIUDAD:
beijing + geom_point(data = datos, aes(Lng, Lat, color = ascensor),size=1.3,alpha=1) +theme(axis.title= element_blank(), axis.text =element_blank())
En los distritos del norte vemos claramente que no tienen ascensor los inmuebles. Y en puro centro de la ciudad tampoco, se empezarían a instalar en pisos de un área fuera del centro histórico.
#DISTRIBUCIÓN DE LA VARIABLE "METRO" EN LA CIUDAD:
beijing + geom_point(data = datos, aes(Lng, Lat, color = metro),size=1.3,alpha=1) +theme(axis.title= element_blank(), axis.text =element_blank())
Vemos como se podía esperar que las viviendas que disponen del servicio de metro cerca, son las que están más céntricas.
#DISTRIBUCIÓN DE LA VARIABLE "FIVEYEARSPROPERTY" EN LA CIUDAD:
beijing + geom_point(data = datos, aes(Lng, Lat, color = fiveYearsProperty),size=1.3,alpha=1) +theme(axis.title= element_blank(), axis.text =element_blank())
Está bastante repartido por toda la ciudad, no depende tanto de la ubicación.
Preprocesado:
DATOS AUSENTES:
#ESTUDIO DATOS AUSENTES EN NUESTRA BASE DE DATOS:
colSums(is.na(datos1))## Lng Lat DOM seguidores
## 0 0 0 0
## salon drawingRoom cocina cuartodebaño
## 0 0 0 0
## floor buildingType renovacionCondicion buildingStrucuture
## 0 316 0 0
## ladderRatio ascensor fiveYearsProperty metro
## 0 0 0 0
## cuadrados1 precio1 totalPrice1
## 0 0 0TENEMOS DATOS AUSENTES EN LA VARIABLE “buildingType”: estilo de edificación. Y faltan 316 datos de un total de 7455 observaciones, que no llega al 5% de los datos. Así que podemos tratarlos más adelante.
plot_missing(datos1)
md.pattern(datos1, rotate.names = T)
## Lng Lat DOM seguidores salon drawingRoom cocina cuartodebaño floor
## 7139 1 1 1 1 1 1 1 1 1
## 316 1 1 1 1 1 1 1 1 1
## 0 0 0 0 0 0 0 0 0
## renovacionCondicion buildingStrucuture ladderRatio ascensor
## 7139 1 1 1 1
## 316 1 1 1 1
## 0 0 0 0
## fiveYearsProperty metro cuadrados1 precio1 totalPrice1 buildingType
## 7139 1 1 1 1 1 1 0
## 316 1 1 1 1 1 0 1
## 0 0 0 0 0 316 316table(datos1$buildingType)##
## 1 2 3 4
## 2448 27 1834 2830Se ve claramente que las mayores ventas, se dan en “lámina” y en “combinación de lamina y torre”, y lo que apenas se vende (no sabemos si porque este tipo de edificación no abunda en Beijing), son los “bungalows”.
VAMOS A IMPUTARLOS CON VARIOS MÉTODOS, Y VEREMOS CUÁL SE AJUSTA MÁS A NUESTROS DATOS REALES:
**Y luego, representaremos la función de densidad del dataframe original -SIN los NAs- vs la del dataframe completo con los datos imputados. De esta manera, podemos ver, de manera gráfica, la bondad de nuestras imputaciones. Transformamos momentáneamente a numérica la variable “buildingType” para verlo.
datos1$buildingType<-as.numeric(datos1$buildingType)# imputamos por el método por defecto de mice: "pmm" (ecuaciones encadenadas)
imputed_data_pmm = mice(datos1,m=5,verbose=T)##
## iter imp variable
## 1 1 buildingType
## 1 2 buildingType
## 1 3 buildingType
## 1 4 buildingType
## 1 5 buildingType
## 2 1 buildingType
## 2 2 buildingType
## 2 3 buildingType
## 2 4 buildingType
## 2 5 buildingType
## 3 1 buildingType
## 3 2 buildingType
## 3 3 buildingType
## 3 4 buildingType
## 3 5 buildingType
## 4 1 buildingType
## 4 2 buildingType
## 4 3 buildingType
## 4 4 buildingType
## 4 5 buildingType
## 5 1 buildingType
## 5 2 buildingType
## 5 3 buildingType
## 5 4 buildingType
## 5 5 buildingType# completamos valores con el resto de columnas
datos_imputados_pmm = complete(imputed_data_pmm)# Comprobamos que ya no existen valores ausentes
sapply(datos_imputados_pmm, function(x) sum(is.na(x)))## Lng Lat DOM seguidores
## 0 0 0 0
## salon drawingRoom cocina cuartodebaño
## 0 0 0 0
## floor buildingType renovacionCondicion buildingStrucuture
## 0 0 0 0
## ladderRatio ascensor fiveYearsProperty metro
## 0 0 0 0
## cuadrados1 precio1 totalPrice1
## 0 0 0#Representamos la función de densidad del dataframe original -SIN los NAs- vs la del dataframe completo con los datos imputados.
plot(density(datos1$buildingType,na.rm = T),col=2,main="Variable buildingType. Método pmm")
lines(density(datos_imputados_pmm$buildingType),col=3)
# Con MICE y Random Forest
imputed_data_rf <- mice(datos1, meth = "rf", ntree = 3)##
## iter imp variable
## 1 1 buildingType
## 1 2 buildingType
## 1 3 buildingType
## 1 4 buildingType
## 1 5 buildingType
## 2 1 buildingType
## 2 2 buildingType
## 2 3 buildingType
## 2 4 buildingType
## 2 5 buildingType
## 3 1 buildingType
## 3 2 buildingType
## 3 3 buildingType
## 3 4 buildingType
## 3 5 buildingType
## 4 1 buildingType
## 4 2 buildingType
## 4 3 buildingType
## 4 4 buildingType
## 4 5 buildingType
## 5 1 buildingType
## 5 2 buildingType
## 5 3 buildingType
## 5 4 buildingType
## 5 5 buildingTypedatos_imputados_pmm_rf = complete(imputed_data_rf)#Representamos la función de densidad del dataframe original -SIN los NAs- vs la del dataframe completo con los datos imputados.
plot(density(datos1$buildingType,na.rm = T),col=2,main="Variable buildingType. Método Random Forest")
lines(density(datos_imputados_pmm_rf$buildingType),col=3)
A LA VISTA DE LAS GRÁFICAS, AMBOS MÉTODOS AJUSTAN BASTANTE BIEN. PERO ALGO MÁS AJUSTADO PARECE QUE QUEDA CON EL MÉTODO MICE-PMM. ASÍ NOS QUEDAREMOS CON ESTA BASE DE DATOS, PARA TRABAJAR CON ELLA DE AQUÍ EN ADELANTE: “datos2<-datos_imputados_pmm” **Y VOLVEMOS A PASAR A FACTOR LA VARIABLE “buildingType” .
datos_imputados_pmm$buildingType<-as.factor(datos_imputados_pmm$buildingType)#NUEVA BASE DE DATOS CON NA`S IMPUTADOS:
head(datos_imputados_pmm)| Lng | Lat | DOM | seguidores | salon | drawingRoom | cocina | cuartodebaño | floor | buildingType | renovacionCondicion | buildingStrucuture | ladderRatio | ascensor | fiveYearsProperty | metro | cuadrados1 | precio1 | totalPrice1 |
|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|
| 116.2324 | 40.23553 | 546 | 6 | 2 | 1 | 1 | 1 | 6 | 4 | 1 | 2 | 0.333 | 0 | 1 | 0 | 4.343805 | 10.002337 | 5.135798 |
| 116.2495 | 40.22179 | 457 | 4 | 3 | 2 | 1 | 2 | 7 | 4 | 4 | 2 | 0.500 | 0 | 1 | 0 | 4.989752 | 10.106714 | 5.886104 |
| 116.5239 | 39.92328 | 430 | 3 | 1 | 0 | 0 | 0 | 32 | 1 | 3 | 6 | 0.500 | 1 | 1 | 1 | 4.965080 | 10.398001 | 6.152733 |
| 116.4300 | 40.06624 | 487 | 52 | 5 | 2 | 1 | 3 | 6 | 4 | 3 | 2 | 0.500 | 0 | 1 | 0 | 5.641375 | 9.932026 | 6.363028 |
| 116.5209 | 39.91885 | 392 | 222 | 3 | 2 | 1 | 1 | 6 | 4 | 2 | 2 | 0.500 | 0 | 1 | 1 | 4.717874 | 10.291569 | 5.799093 |
| 116.2258 | 39.80226 | 398 | 207 | 2 | 1 | 1 | 1 | 6 | 3 | 2 | 1 | 0.250 | 0 | 0 | 1 | 4.396176 | 10.112492 | 5.298317 |
str(datos_imputados_pmm)## 'data.frame': 7455 obs. of 19 variables:
## $ Lng : num 116 116 117 116 117 ...
## $ Lat : num 40.2 40.2 39.9 40.1 39.9 ...
## $ DOM : int 546 457 430 487 392 398 369 370 347 272 ...
## $ seguidores : int 6 4 3 52 222 207 73 26 114 81 ...
## $ salon : int 2 3 1 5 3 2 3 4 3 1 ...
## $ drawingRoom : int 1 2 0 2 2 1 1 2 1 1 ...
## $ cocina : int 1 1 0 1 1 1 1 1 1 1 ...
## $ cuartodebaño : int 1 2 0 3 1 1 1 2 1 1 ...
## $ floor : Factor w/ 37 levels "1","2","3","4",..: 6 7 32 6 6 6 18 8 9 18 ...
## $ buildingType : Factor w/ 4 levels "1","2","3","4": 4 4 1 4 4 3 1 4 3 1 ...
## $ renovacionCondicion: Factor w/ 4 levels "1","2","3","4": 1 4 3 3 2 2 3 3 4 4 ...
## $ buildingStrucuture : Factor w/ 6 levels "1","2","3","4",..: 2 2 6 2 2 1 6 6 6 6 ...
## $ ladderRatio : num 0.333 0.5 0.5 0.5 0.5 0.25 0.333 0.333 0.333 0.5 ...
## $ ascensor : Factor w/ 2 levels "0","1": 1 1 2 1 1 1 2 2 2 2 ...
## $ fiveYearsProperty : Factor w/ 2 levels "0","1": 2 2 2 2 2 1 1 1 2 1 ...
## $ metro : Factor w/ 2 levels "0","1": 1 1 2 1 2 2 1 2 2 1 ...
## $ cuadrados1 : num 4.34 4.99 4.97 5.64 4.72 ...
## $ precio1 : num 10 10.11 10.4 9.93 10.29 ...
## $ totalPrice1 : num 5.14 5.89 6.15 6.36 5.8 ...ESTUDIO DE VALORES ANÓMALOS: “OUTLIERS” Cogemos solamente las variables numéricas.
datos_imputados_pmm %>%
diagnose_outlier(cuadrados1,precio1,totalPrice1,DOM,ladderRatio,seguidores)| variables | outliers_cnt | outliers_ratio | outliers_mean | with_mean | without_mean | |
|---|---|---|---|---|---|---|
| cuadrados1 | cuadrados1 | 160 | 2.1462106 | 4.209594 | 4.3408265 | 4.3437048 |
| precio1 | precio1 | 67 | 0.8987257 | 7.961943 | 10.5819780 | 10.6057385 |
| totalPrice1 | totalPrice1 | 108 | 1.4486922 | 5.137513 | 5.7136677 | 5.7221371 |
| DOM | DOM | 1561 | 20.9389671 | 62.745035 | 14.3192488 | 1.4938921 |
| ladderRatio | ladderRatio | 224 | 3.0046948 | 1.060411 | 0.3603976 | 0.3387128 |
| seguidores | seguidores | 675 | 9.0543260 | 80.211852 | 14.4804829 | 7.9364307 |
datos_imputados_pmm %>%
plot_outlier(cuadrados1,precio1,totalPrice1,DOM,ladderRatio,seguidores)
**vemos cómo cambian las distribuciones de las variables cuando se eliminan los “outliers”. Pero hay que tener en cuenta, cuando tiene sentido eliminarlos y cuando no lo tiene. Por ejemplo: - en la variable de “cuadrados1”, seguramente se trata de pisos que se salen de la media en cuanto a tamaño. Estudiaremos si es error o no más adelante, aunque todo indica que sí. - En las variable “precio1” y “totalPrice” mejoran notablemente las distribuciones, parece que los outliers sean errores en la entrada de datos. imprimiremos sus outliers para estudiar esto. - La variable “DOM” sigue guardando su distribución llena de CEROS que en realidad, no nos interesará contar con ella para hacer los estudios siguientes, al igual que la variable “seguidores”. - LatterRatio mejora la distribución sin outliers, aunque también tiene muchos datos CEROS.
IMPRIMIMOS LOS OUTLIERS DE “PRECIO TOTAL”:( desde nuestra base de datos original, antes de hacer la transformación logarítmica.)
boxplot(datos$totalPrice)
outprecioTotal<-boxplot(datos$totalPrice)$out
sort(outprecioTotal)## [1] 806.0 808.0 808.0 809.0 810.0 810.0 810.0 810.0 810.0 810.0
## [11] 813.6 815.0 815.0 815.0 815.0 817.0 817.5 818.0 819.0 820.0
## [21] 820.0 820.0 820.0 820.0 820.0 821.0 823.0 825.0 825.0 826.0
## [31] 828.0 828.0 828.0 830.0 830.0 830.0 830.0 830.0 830.0 830.0
## [41] 830.0 830.0 830.0 830.0 832.0 835.0 835.0 835.0 838.0 839.9
## [51] 840.0 840.0 840.0 840.0 840.0 845.0 846.0 848.0 850.0 850.0
## [61] 850.0 850.0 850.0 850.0 851.0 851.8 852.0 852.0 855.0 855.0
## [71] 855.0 856.0 856.0 856.0 857.0 858.0 858.0 858.0 860.0 860.0
## [81] 860.0 860.0 865.0 866.0 870.0 870.0 870.0 870.0 870.6 874.0
## [91] 877.0 880.0 880.0 880.0 880.0 880.0 880.0 883.0 885.0 890.0
## [101] 890.0 890.0 890.0 895.0 896.0 898.0 898.0 900.0 900.0 900.0
## [111] 900.0 900.0 900.0 900.0 900.0 900.0 900.0 900.0 900.0 900.0
## [121] 905.0 906.0 908.0 910.0 910.0 913.0 915.0 918.0 920.0 920.0
## [131] 920.0 920.0 920.0 920.0 920.0 925.0 925.0 926.0 928.0 930.0
## [141] 930.0 930.0 930.0 930.0 935.0 935.0 937.0 937.0 938.8 940.0
## [151] 940.0 940.0 946.0 948.0 950.0 950.0 950.0 950.0 950.0 950.0
## [161] 950.0 952.0 955.0 955.0 955.0 956.0 960.0 960.0 960.0 960.0
## [171] 960.0 960.0 962.0 965.0 966.0 968.0 970.0 970.0 970.0 972.0
## [181] 975.0 979.0 980.0 980.0 980.0 980.0 980.0 980.0 980.0 980.0
## [191] 981.0 983.0 985.0 986.0 990.0 992.0 998.0 999.0 1000.0 1000.0
## [201] 1000.0 1000.0 1000.0 1000.0 1000.0 1000.0 1000.0 1000.0 1000.0 1000.0
## [211] 1005.0 1010.0 1010.0 1010.0 1010.0 1022.0 1025.0 1030.0 1035.0 1038.0
## [221] 1038.0 1039.8 1040.0 1040.0 1042.0 1048.0 1048.0 1050.0 1050.0 1050.0
## [231] 1059.0 1060.0 1060.0 1065.0 1070.0 1080.0 1080.0 1080.0 1080.0 1090.0
## [241] 1090.0 1090.0 1099.0 1100.0 1100.0 1100.0 1100.0 1100.0 1100.0 1100.0
## [251] 1100.0 1100.0 1115.0 1120.0 1120.0 1120.0 1120.0 1120.0 1120.0 1120.0
## [261] 1130.0 1130.0 1140.0 1140.0 1145.0 1146.0 1150.0 1150.0 1150.0 1150.0
## [271] 1150.0 1150.9 1158.0 1160.0 1160.0 1160.0 1160.0 1170.0 1170.0 1180.0
## [281] 1180.0 1180.0 1180.0 1182.0 1190.0 1195.0 1195.0 1200.0 1200.0 1200.0
## [291] 1215.0 1220.0 1220.0 1230.0 1237.0 1238.0 1250.0 1250.0 1250.0 1251.0
## [301] 1255.0 1258.0 1260.0 1260.0 1270.0 1270.0 1270.0 1285.0 1285.0 1288.0
## [311] 1292.0 1296.0 1300.0 1300.0 1300.0 1300.0 1300.0 1300.0 1300.0 1300.0
## [321] 1308.0 1309.0 1320.0 1324.0 1330.0 1345.0 1350.0 1350.0 1350.0 1350.0
## [331] 1350.0 1355.0 1355.0 1360.0 1360.0 1368.0 1380.0 1380.0 1385.0 1400.0
## [341] 1400.0 1400.0 1400.0 1410.0 1430.0 1435.0 1440.0 1450.0 1450.0 1460.0
## [351] 1490.6 1500.0 1500.0 1500.0 1505.0 1510.0 1510.0 1510.0 1528.0 1540.0
## [361] 1550.0 1550.0 1560.0 1570.0 1580.0 1590.0 1600.0 1600.0 1620.0 1660.0
## [371] 1670.0 1688.0 1700.0 1700.0 1730.0 1745.0 1760.0 1760.0 1780.0 1800.0
## [381] 1880.0 1980.0 2030.0 2050.0 2100.0 2130.0 2250.0 2300.0 2400.0 2420.0
## [391] 2490.0 2600.0 2620.0 2680.0 2700.0 2738.0 2742.6 3300.0 3350.0 3620.0
## [401] 3840.0 4250.0 4650.0min(datos$totalPrice)## [1] 0.1max(datos$totalPrice)## [1] 4650plot(datos$totalPrice)
VEMOS QUE LA MEDIA DE LOS PRECIOS MÁS ALTOS, SON UNOS 1200-1500 MILLONES DE YENES. ASÍ QUE TODO INDICA, AUNQUE CON EL CAMBIO DE MONEDA Y DE PAÍS PUEDE SER MÁS COMPLICADO SITUARNOS EN ESE MERCADO DE PRECIOS, QUE DEBEN SER ERRORES LOS VALORES QUE ESTÁN POR ENCIMA DE ESTOS. AL METER LOS DATOS DE 300 Y 400 MILLONES DE YENES, QUE HAYAN AÑADIDO UN CERO MÁS POR ERROR, Y ASÍ APARECER PISOS DE 3000-4000 MILLONES DE YENES. ASÍ QUE VAMOS A IMPUTAR LOS OUTLIERS DE ESTA VARIABLE.
IMPRIMIMOS LOS OUTLIERS DE LA VARIABLE METROS “CUADRADOS”:
boxplot(datos$cuadrados)
outCuadrados<-boxplot(datos$cuadrados)$out
sort(outCuadrados)## [1] 165.84 165.96 165.96 165.96 165.96 166.04 166.04 166.17 166.17 166.17
## [11] 166.66 166.90 166.90 167.00 167.00 167.00 167.11 167.12 167.15 167.50
## [21] 167.60 167.67 167.70 167.97 167.97 168.06 168.37 168.37 168.49 168.71
## [31] 168.95 169.00 169.14 169.76 169.76 169.89 169.92 169.92 170.21 170.33
## [41] 170.61 170.65 170.80 171.00 171.05 171.06 171.06 171.20 171.49 171.58
## [51] 171.58 171.68 172.13 172.41 172.44 173.00 173.49 173.64 173.74 173.95
## [61] 174.00 174.33 174.33 174.60 174.61 174.68 174.70 174.70 174.72 174.72
## [71] 174.85 174.86 175.00 175.00 175.00 175.55 175.62 175.70 176.00 176.00
## [81] 176.00 176.02 176.02 176.03 176.88 176.97 176.97 177.02 177.19 177.19
## [91] 177.32 177.32 177.39 177.76 177.79 177.89 178.21 178.21 178.55 178.59
## [101] 178.87 179.05 179.14 179.14 179.41 179.48 179.48 179.79 179.95 180.30
## [111] 180.43 180.70 181.16 181.31 181.31 181.68 181.68 181.93 182.00 182.00
## [121] 182.02 182.02 182.13 182.29 182.46 183.00 183.09 183.39 183.47 183.91
## [131] 184.23 185.34 185.57 186.00 186.26 186.26 186.46 186.47 186.47 186.59
## [141] 186.67 187.26 187.58 188.25 188.56 188.56 188.80 189.16 189.65 190.85
## [151] 190.85 190.97 190.97 190.97 190.97 191.34 191.65 192.29 192.29 192.49
## [161] 193.41 193.49 194.00 194.15 196.25 196.93 199.59 199.91 200.00 201.19
## [171] 201.89 201.89 201.89 201.90 202.00 202.51 203.43 203.65 204.40 204.66
## [181] 204.66 204.66 205.00 205.09 205.25 205.37 205.54 205.54 205.94 205.95
## [191] 205.95 205.95 207.12 207.21 208.73 208.79 210.19 211.03 211.61 211.88
## [201] 212.54 212.64 213.47 214.03 214.98 215.00 215.60 215.89 216.03 216.12
## [211] 216.43 216.48 216.89 216.98 218.10 219.22 219.22 219.26 219.39 219.39
## [221] 219.95 219.95 220.00 220.00 220.36 220.40 220.66 220.78 221.80 222.18
## [231] 222.24 223.00 223.16 223.53 223.80 225.00 225.64 226.95 227.74 228.17
## [241] 228.88 228.88 228.96 229.00 229.42 229.43 229.50 229.79 229.88 231.24
## [251] 232.18 232.50 236.73 236.99 237.82 237.86 237.93 238.66 239.54 240.97
## [261] 243.67 245.02 246.46 250.00 250.00 250.45 251.82 253.00 253.02 254.89
## [271] 255.68 256.06 258.81 259.00 261.96 262.22 266.31 266.86 268.72 270.00
## [281] 271.00 272.00 272.00 272.94 273.12 273.26 274.00 275.00 279.16 279.16
## [291] 281.38 281.85 281.88 284.87 294.00 296.57 296.57 296.57 296.57 297.58
## [301] 302.82 304.73 304.73 311.75 320.00 328.06 334.00 335.77 342.28 348.89
## [311] 355.00 356.67 358.00 361.00 367.00 369.40 372.82 374.90 380.00 382.00
## [321] 383.52 409.00 411.29 435.51 440.84 449.35 452.80 458.00 469.55 495.65
## [331] 573.77 922.70min(datos$cuadrados)## [1] 6.9max(datos$cuadrados)## [1] 922.7plot(datos$cuadrados)
VEMOS QUE DE MANERA MEDIA SIN TENER EN CUENTA LOS VALORES ATÍPICOS, COMO NÚMEROS DE METROS CUADRADOS NO LLEGA A 200M2. LO QUE TODO INDICA QUE LOS VALORES ATÍPICOS DE 400M2, 600M2 Y 900M2 SE DEBAN A ERRORES EN LA INTRODUCIÓN DE LOS DATOS. LOS IMPUTAREMOS.
LIMPIAMOS OUTLIERS DE TODAS LAS VARIABLES ANTERIORES PARA MEJORAR BASE DATOS:
variables = c("cuadrados1","precio1","totalPrice1","DOM","ladderRatio" ,"seguidores")
var_stop_bottom_top <- prep_outliers(data=datos_imputados_pmm,
input=variables,
type='stop', top_percent = 0.01,method = "bottom_top")
datos_limpios<-var_stop_bottom_topsapply(datos_limpios, function(x) sum(is.na(x)))## Lng Lat DOM seguidores
## 0 0 0 0
## salon drawingRoom cocina cuartodebaño
## 0 0 0 0
## floor buildingType renovacionCondicion buildingStrucuture
## 0 0 0 0
## ladderRatio ascensor fiveYearsProperty metro
## 0 0 0 0
## cuadrados1 precio1 totalPrice1
## 0 0 0EN ADELANTE TRABAJAREMOS CON LA BASE DE DATOS: “datos_limpios”
str(datos_limpios)## 'data.frame': 7455 obs. of 19 variables:
## $ Lng : num 116 116 117 116 117 ...
## $ Lat : num 40.2 40.2 39.9 40.1 39.9 ...
## $ DOM : num 171 171 171 171 171 ...
## $ seguidores : num 6 4 3 52 122 ...
## $ salon : int 2 3 1 5 3 2 3 4 3 1 ...
## $ drawingRoom : int 1 2 0 2 2 1 1 2 1 1 ...
## $ cocina : int 1 1 0 1 1 1 1 1 1 1 ...
## $ cuartodebaño : int 1 2 0 3 1 1 1 2 1 1 ...
## $ floor : Factor w/ 37 levels "1","2","3","4",..: 6 7 32 6 6 6 18 8 9 18 ...
## $ buildingType : Factor w/ 4 levels "1","2","3","4": 4 4 1 4 4 3 1 4 3 1 ...
## $ renovacionCondicion: Factor w/ 4 levels "1","2","3","4": 1 4 3 3 2 2 3 3 4 4 ...
## $ buildingStrucuture : Factor w/ 6 levels "1","2","3","4",..: 2 2 6 2 2 1 6 6 6 6 ...
## $ ladderRatio : num 0.333 0.5 0.5 0.5 0.5 0.25 0.333 0.333 0.333 0.5 ...
## $ ascensor : Factor w/ 2 levels "0","1": 1 1 2 1 1 1 2 2 2 2 ...
## $ fiveYearsProperty : Factor w/ 2 levels "0","1": 2 2 2 2 2 1 1 1 2 1 ...
## $ metro : Factor w/ 2 levels "0","1": 1 1 2 1 2 2 1 2 2 1 ...
## $ cuadrados1 : num 4.34 4.99 4.97 5.47 4.72 ...
## $ precio1 : num 10 10.11 10.4 9.93 10.29 ...
## $ totalPrice1 : num 5.14 5.89 6.15 6.36 5.8 ...GRÁFICAS VARIABLES FRENTE A VARIABLE OBJETIVO “PRECIO TOTAL”:
ggplot(datos_limpios, aes(x = exp(cuadrados1), y =exp(totalPrice1))) +
geom_smooth() ## `geom_smooth()` using method = 'gam' and formula = 'y ~ s(x, bs = "cs")'
ggplot(datos_limpios, aes(x = exp(precio1) , y =exp(totalPrice1))) +
geom_smooth() ## `geom_smooth()` using method = 'gam' and formula = 'y ~ s(x, bs = "cs")'
ggplot(datos_limpios, aes(x = ladderRatio , y =exp(totalPrice1))) +
geom_smooth() ## `geom_smooth()` using method = 'gam' and formula = 'y ~ s(x, bs = "cs")'
ggplot(datos_limpios, aes(x = seguidores , y =exp(totalPrice1))) +
geom_smooth() ## `geom_smooth()` using method = 'gam' and formula = 'y ~ s(x, bs = "cs")'
ggplot(datos_limpios, aes(x = DOM , y =exp(totalPrice1))) +
geom_smooth() ## `geom_smooth()` using method = 'gam' and formula = 'y ~ s(x, bs = "cs")'
ggplot(datos_limpios, aes(x = Lng , y =exp(totalPrice1))) +
geom_smooth() ## `geom_smooth()` using method = 'gam' and formula = 'y ~ s(x, bs = "cs")'
ggplot(datos_limpios, aes(x = Lat , y =exp(totalPrice1))) +
geom_smooth() ## `geom_smooth()` using method = 'gam' and formula = 'y ~ s(x, bs = "cs")'
Como ya habíamos advertido anteriormente, la variable PRECIO TOTAL depende linealmente de las variables (PRECIO, METROS CUADRADOS, ESCALERAS Y DÍAS QUE ESTÁ EN EL MERCADO– la entendemos, como que los precios más baratos enseguida se venden, y los precios altos duran más tiempo anunciados, ya que no están al alcance de cualquiera. Y las variables de LATITUD Y LONGITUD, alcanzan precios más altos en la parte central de ambos, es decir en el centro de la ciudad de Beijing.
“PRECIO TOTAL EN FUNCIÓN DEL TIPO DE CONSTRUCCIÓN”
ggplot(datos_limpios , aes(x= buildingType, y=exp(totalPrice1), color = buildingType))+
geom_boxplot() + labs(title = "PRECIO TOTAL EN FUNCIÓN DEL TIPO DE CONSTRUCCIÓN", y =" totalPrice ")
El precio más alto es el de las Torres, y el más bajo es el de los bungalows que suelen ser de madera y que solamente han vendido 27. Un número bajísimo con respecto al resto de construcciones.
table(datos_limpios$buildingType)##
## 1 2 3 4
## 2482 27 1902 3044“PRECIO TOTAL EN FUNCIÓN DEL MATERIAL DE CONSTRUCCIÓN”
ggplot(datos_limpios, aes(x= buildingStrucuture, y=exp(totalPrice1), color = buildingStrucuture))+
geom_boxplot() + labs(title = "PRECIO TOTAL EN FUNCIÓN DEL MATERIAL DE CONSTRUCCIÓN", y ="PRECIO TOTAL")
El precio aumenta en los pisos de acero y hormigón y menor en la madera (material con el que se construyen los bungalows). No parece depender mucho la estructura del edificio con el precio total, no incluiremos esta variable en el modelo.
table(datos_limpios$buildingStrucuture)##
## 1 2 3 4 5 6
## 113 1783 73 222 5 5259“PRECIO EN FUNCIÓN DE LA REFORMA DEL PISO”
ggplot(datos_limpios, aes(x= renovacionCondicion, y=exp(totalPrice1), color = renovacionCondicion))+
geom_boxplot() + labs(title = "PRECIO EN FUNCIÓN DE LA REFORMA DEL PISO", y ="PRECIO TOTAL")
El precio aumenta cuanto más reformado está el piso.
table(datos_limpios$renovacionCondicion)##
## 1 2 3 4
## 2186 187 1651 3431“PRECIO EN FUNCIÓN DE LA PROXIMIDAD DEL METRO”
ggplot(datos_limpios, aes(x= metro, y=exp(totalPrice1), color = metro))+
geom_boxplot() + labs(title = "PRECIO EN FUNCIÓN DE LA PROXIMIDAD DEL METRO", y ="PRECIO TOTAL")
El precio aumenta un poco en los pisos cercanos a una parada de metro, pero con muy poca diferencia de precios.
table(datos_limpios$metro)##
## 0 1
## 3013 4442“PRECIO EN FUNCIÓN DE FINCA CON ASCENSOR”
ggplot(datos_limpios, aes(x= ascensor, y=exp(totalPrice1), color = ascensor))+
geom_boxplot() + labs(title = "PRECIO EN FUNCIÓN DE FINCA CON ASCENSOR", y ="PRECIO TOTAL")
El precio SÍ aumenta en las fincas con ascensor, pero con poca diferencia con respecto a los pisos que no tienen.
table(datos_limpios$ascensor)##
## 0 1
## 2296 5159“PRECIO EN FUNCIÓN DE LA ALTURA DEL PISO”
ggplot(datos_limpios, aes(x= floor, y=exp(totalPrice1), color = floor))+
geom_boxplot() + labs(title = "PRECIO EN FUNCIÓN DE LA ALTURA DEL PISO", y ="PRECIO TOTAL")
Las alturas más bajas y más altas son las más cotizadas.
table(datos_limpios$floor)##
## 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16
## 99 21 45 53 219 1497 167 72 169 175 190 238 108 139 232 479
## 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32
## 110 452 51 228 399 545 94 409 191 198 215 289 75 107 54 16
## 33 34 36 37 42
## 12 92 3 4 8La altura más vendida, es la altura 6ªplanta del edificio, con bastante diferencia del resto. No sé si serán edificios de 6 alturas en las que se cotice más como la última planta o ático. O que tenga que ver con algo supersticioso o de creencia en el número 6. AL desconocer estos datos no se puede confirmar nada, pero es curioso.
“PRECIO EN FUNCIÓN DEL TIEMPO QUE TIENE EL PISO”
ggplot(datos_limpios, aes(x= fiveYearsProperty, y=exp(totalPrice1), color = fiveYearsProperty))+
geom_boxplot() + labs(title = "PRECIO EN FUNCIÓN DEL TIEMPO QUE TIENE EL PISO", y ="PRECIO TOTAL")
Los pisos que tienen menos tiempo de construcción se venden con un precio más alto. Pero es tan poca la diferencia entre unos y otros, que no da la suficiente información como para tenerla en cuenta en el modelo.
table(datos_limpios$fiveYearsProperty)##
## 0 1
## 3321 4134CORRELACIÓN ENTRE VARIABLES NUMÉRICAS:
Elegimos las variables numéricas para hacer las correlaciones, y antes quitamos las que no lo son, y quitamos las variables “latitud” y “longitud” por ser coordenadas.
numericas=datos_limpios[,c(3,4,5,6,7,8,13,17,18,19)]
corr_datos = as.data.frame((cor(numericas)))
round(corr_datos,2)| DOM | seguidores | salon | drawingRoom | cocina | cuartodebaño | ladderRatio | cuadrados1 | precio1 | totalPrice1 | |
|---|---|---|---|---|---|---|---|---|---|---|
| DOM | 1.00 | 0.52 | 0.09 | 0.03 | 0.01 | 0.08 | 0.02 | 0.08 | 0.19 | 0.22 |
| seguidores | 0.52 | 1.00 | 0.04 | -0.03 | 0.03 | -0.03 | -0.01 | -0.03 | 0.19 | 0.15 |
| salon | 0.09 | 0.04 | 1.00 | 0.56 | 0.17 | 0.60 | 0.41 | 0.73 | -0.08 | 0.43 |
| drawingRoom | 0.03 | -0.03 | 0.56 | 1.00 | 0.22 | 0.50 | 0.37 | 0.66 | -0.10 | 0.36 |
| cocina | 0.01 | 0.03 | 0.17 | 0.22 | 1.00 | 0.26 | 0.09 | 0.27 | -0.11 | 0.08 |
| cuartodebaño | 0.08 | -0.03 | 0.60 | 0.50 | 0.26 | 1.00 | 0.30 | 0.65 | -0.06 | 0.40 |
| ladderRatio | 0.02 | -0.01 | 0.41 | 0.37 | 0.09 | 0.30 | 1.00 | 0.42 | -0.08 | 0.22 |
| cuadrados1 | 0.08 | -0.03 | 0.73 | 0.66 | 0.27 | 0.65 | 0.42 | 1.00 | -0.18 | 0.52 |
| precio1 | 0.19 | 0.19 | -0.08 | -0.10 | -0.11 | -0.06 | -0.08 | -0.18 | 1.00 | 0.74 |
| totalPrice1 | 0.22 | 0.15 | 0.43 | 0.36 | 0.08 | 0.40 | 0.22 | 0.52 | 0.74 | 1.00 |
plot_correlation(numericas)
VEMOS QUE HAY VARIABLES QUE ESTÁN MUY CORRELACIONADAS ENTRE SÍ, Y MUY CORRELACIONADAS CON EL PRECIO TOTAL DE LA VIVIENDA:
El PRECIO TOTAL está correlacionado con los METROS CUADRADOS, el NÚMERO DE HABITACIONES y de BAÑOS, y muy correlacionada, claramente, con el PRECIO por metro cuadrado.
los METROS CUADRADOS, están correlacionados con el NÚMERO DE HABITACIONES en general, y por supuesto como ya hemos dicho, con el PRECIO TOTAL.
el NÚMERO DE HABITACIONES, SALONES Y BAÑOS está relacionado con el NÚMERO DE OTRAS ESTANCIAS, con LAS ESCALERAS que tiene y con el PRECIO TOTAL.
los DÍAS DE MERCADO,están correlacionados con la variable “SEGUIDORES”.
Selección de Variables Cuantitativas:
VAMOS A HACER UN ESTUDIO DE LA ESFERICIDAD DE BARLETT Y DEL KMO, PARA VER CÓMO ES LA CORRELACIÓN ENTRE LAS VARIABLES Y SI TENEMOS QUE TOMAR MEDIDAS ANTES DE EMPEZAR A MODELAR Y A APLICAR ALGORITMOS.
**DEJANDO LA VARIABLE OBJETIVO FUERA (totalprice) Y LA LONGITUD Y LATITUD.
**Vemos que hay correlación entre DOM y SEGUIDORES, pero como la variable DOM la vamos a eliminar del modelo por tener tantos valores iguales, Pues no metemos la variable “seguidores” en el estudio de la esfericidad. Y sí la tendremos en cuenta después para el modelo.
**Hacemos lo mismo con la variable precio m2, que al tener tanta correlación con la variable objetivo, no vamos a tenerla en cuenta para el modelo.
Así que, solamente vamos a ver si el resto de variables que tienen que ver con los metros cuadrados y el número de estancias, tienen la correlación suficiente para hacer con ellas variables nuevas mediante componentes principales, y así reducir dimensiones.
library(psych)##
## Attaching package: 'psych'## The following object is masked from 'package:Hmisc':
##
## describe## The following object is masked from 'package:car':
##
## logit## The following object is masked from 'package:randomForest':
##
## outlier## The following objects are masked from 'package:ggplot2':
##
## %+%, alpha## The following object is masked from 'package:dlookr':
##
## describecortest.bartlett(datos_limpios[,c(5,6,7,8,13,17)])## R was not square, finding R from data## $chisq
## [1] 17267.34
##
## $p.value
## [1] 0
##
## $df
## [1] 15Vemos que el resultado del test es compatible con la existencia de correlacion suficiente para hacer componentes ppales p-value<0.05.
KMO(datos_limpios[,c(5,6,7,8,13,17)])## Kaiser-Meyer-Olkin factor adequacy
## Call: KMO(r = datos_limpios[, c(5, 6, 7, 8, 13, 17)])
## Overall MSA = 0.84
## MSA for each item =
## salon drawingRoom cocina cuartodebaño ladderRatio cuadrados1
## 0.83 0.88 0.85 0.88 0.92 0.79Vemos que la medida del KMO para todas las variables es superior a 0.5, así que podemos dejar todas y hacer combinaciones lineales entre ellas, para hallar variables nuevas y así reducir el número de variables.
APLICAMOS COMPONENTES PRINCIPALES
salon,drawingRoom ,cocina ,cuartodebaño,ladderRatio ,cuadrados1
datos_limpios2<-datos_limpios[, c(5 ,6, 7, 8, 13, 17)]
str(datos_limpios2)## 'data.frame': 7455 obs. of 6 variables:
## $ salon : int 2 3 1 5 3 2 3 4 3 1 ...
## $ drawingRoom : int 1 2 0 2 2 1 1 2 1 1 ...
## $ cocina : int 1 1 0 1 1 1 1 1 1 1 ...
## $ cuartodebaño: int 1 2 0 3 1 1 1 2 1 1 ...
## $ ladderRatio : num 0.333 0.5 0.5 0.5 0.5 0.25 0.333 0.333 0.333 0.5 ...
## $ cuadrados1 : num 4.34 4.99 4.97 5.47 4.72 ...limpios.pc <- princomp(datos_limpios2,cor=TRUE,scale=TRUE)## Warning: In princomp.default(datos_limpios2, cor = TRUE, scale = TRUE) :
## extra argument 'scale' will be disregardedsummary(limpios.pc,loadings=TRUE,scale=TRUE)## Importance of components:
## Comp.1 Comp.2 Comp.3 Comp.4 Comp.5
## Standard deviation 1.7953291 0.9710155 0.8461141 0.70451923 0.61981260
## Proportion of Variance 0.5372011 0.1571452 0.1193182 0.08272456 0.06402794
## Cumulative Proportion 0.5372011 0.6943463 0.8136644 0.89638900 0.96041694
## Comp.6
## Standard deviation 0.48733804
## Proportion of Variance 0.03958306
## Cumulative Proportion 1.00000000
##
## Loadings:
## Comp.1 Comp.2 Comp.3 Comp.4 Comp.5 Comp.6
## salon 0.469 0.146 0.188 0.161 0.677 0.489
## drawingRoom 0.439 -0.800 -0.319 0.235
## cocina 0.202 -0.910 -0.341 0.104
## cuartodebaño 0.439 0.319 0.557 -0.608 0.139
## ladderRatio 0.323 0.377 -0.846 0.153 -0.118
## cuadrados1 0.499 0.147 0.213 -0.826Con la primera componente explicamos el 54% de las variables elegidas. Pasando de 8 variables a tan solo 1. El resto de variables no incluídas en los componentes principales, las añadiremos si lo vemos conveniente en el modelo, tal y como hemos comentado antes. En principio, la variable “precio por metro cuadrado” no, ya que está muy correlacionada con la variable objetivo. Y tampoco la variable “DOM”. Además añadiremos todas las variables categóricas que nos sean explicativas significativamente.
plot(limpios.pc)
LA NUEVA VARIABLE SERÁ:
principales<-limpios.pc$scores[,1]
summary(principales)## Min. 1st Qu. Median Mean 3rd Qu. Max.
## -6.4954 -1.1525 -0.1893 0.0000 0.9348 11.6032COMPONENTE1=PRINCIPALES será la variable combinación lineal de todas las cuantitativas: salon,drawingRoom ,cocina ,cuartodebaño,ladderRatio ,cuadrados1, QUE TIENEN QUE VER CON EL TAMAÑO DE LA VIVIENDA Y POR LO TANTO EL NÚMERO DE ESTANCIAS QUE TIENE.
Modelización:
Datos para los modelos:
**Variables:
PRINCIPALES–(combinación lineal de las variables: salon,drawingRoom ,cocina ,cuartodebaño,ladderRatio ,cuadrados1) LONGITUD Y LATITUD BUILDING_TYPE, BUILDING_STRUCTURE, RENOVACIONCONDICION, METRO, ASCENSOR, FLOOR y la variable objetivo “TOTALPRICE1”.
(Dejamos fuera del modelo: “precio” por metro2, y la variable “DOM” y también la variable “FIVEYEARSPROPERTY” y “BUILDING-STRUCTURE”)
library(stats)
datosFinal<-cbind(principales,datos_limpios[, c(1,2,4,9,10,11,12,14,16,19)])
head(datosFinal)| principales | Lng | Lat | seguidores | floor | buildingType | renovacionCondicion | buildingStrucuture | ascensor | metro | totalPrice1 |
|---|---|---|---|---|---|---|---|---|---|---|
| -0.2322052 | 116.2324 | 40.23553 | 6.00 | 6 | 4 | 1 | 2 | 0 | 0 | 5.135798 |
| 2.9498822 | 116.2495 | 40.22179 | 4.00 | 7 | 4 | 4 | 2 | 0 | 0 | 5.886104 |
| -2.6655683 | 116.5239 | 39.92328 | 3.00 | 32 | 1 | 3 | 6 | 1 | 1 | 6.152733 |
| 5.4828705 | 116.4300 | 40.06624 | 52.00 | 6 | 4 | 3 | 2 | 0 | 0 | 6.363028 |
| 1.7733238 | 116.5209 | 39.91885 | 122.46 | 6 | 4 | 2 | 2 | 0 | 1 | 5.799093 |
| -0.3255857 | 116.2258 | 39.80226 | 122.46 | 6 | 3 | 2 | 1 | 0 | 1 | 5.298317 |
Variables de control de los modelos:
library(caret)
# TrainControl general con método de validación cruzada con 5 particiones por 1 repeticiones.
control <- trainControl(
method = "repeatedcv",
number = 5,
repeats = 1,
returnResamp = "final",
allowParallel = TRUE
)
#Como metrica utilizaremos RMSE en todos los casos.
metrica <- "RMSE"Creación del fichero de entrenamiento y test para “precio total”:
# Creamos muestras de entrenamiento y de test (80% - 20%)
set.seed(100)
train_sample <- createDataPartition(y = datosFinal$totalPrice1, p = .8, list = FALSE)
train_prTotal <- datosFinal[train_sample,]
test_prTotal <- datosFinal[-train_sample,]
#-- Save train/test precioTotal.
save(train_prTotal, test_prTotal, file = "traintest_prTotal.RData")fichero de entrenamiento
summary(train_prTotal )## principales Lng Lat seguidores
## Min. :-6.495359 Min. :116.1 Min. :39.63 Min. : 0.0
## 1st Qu.:-1.164264 1st Qu.:116.3 1st Qu.:39.89 1st Qu.: 1.0
## Median :-0.191655 Median :116.4 Median :39.93 Median : 5.0
## Mean : 0.004976 Mean :116.4 Mean :39.95 Mean : 13.8
## 3rd Qu.: 0.941452 3rd Qu.:116.5 3rd Qu.:39.99 3rd Qu.: 17.0
## Max. :11.603205 Max. :116.7 Max. :40.25 Max. :122.5
##
## floor buildingType renovacionCondicion buildingStrucuture ascensor
## 6 :1185 1:2023 1:1744 1: 85 0:1825
## 22 : 434 2: 22 2: 155 2:1400 1:4141
## 16 : 399 3:1504 3:1311 3: 61
## 18 : 354 4:2417 4:2756 4: 187
## 24 : 326 5: 5
## 21 : 321 6:4228
## (Other):2947
## metro totalPrice1
## 0:2387 Min. :-2.303
## 1:3579 1st Qu.: 5.323
## Median : 5.720
## Mean : 5.711
## 3rd Qu.: 6.098
## Max. : 7.208
## fichero de test
summary(test_prTotal )## principales Lng Lat seguidores
## Min. :-5.92735 Min. :116.1 Min. :39.63 Min. : 0.00
## 1st Qu.:-1.11750 1st Qu.:116.3 1st Qu.:39.89 1st Qu.: 1.00
## Median :-0.18591 Median :116.4 Median :39.93 Median : 5.00
## Mean :-0.01994 Mean :116.4 Mean :39.94 Mean : 13.78
## 3rd Qu.: 0.92369 3rd Qu.:116.5 3rd Qu.:39.99 3rd Qu.: 16.00
## Max. : 8.55499 Max. :116.7 Max. :40.25 Max. :122.46
##
## floor buildingType renovacionCondicion buildingStrucuture ascensor
## 6 :312 1:459 1:442 1: 28 0: 471
## 22 :111 2: 5 2: 32 2: 383 1:1018
## 18 : 98 3:398 3:340 3: 12
## 24 : 83 4:627 4:675 4: 35
## 16 : 80 5: 0
## 21 : 78 6:1031
## (Other):727
## metro totalPrice1
## 0:626 Min. :0.6931
## 1:863 1st Qu.:5.3230
## Median :5.7203
## Mean :5.7092
## 3rd Qu.:6.0981
## Max. :7.2079
## clusterCPU <- makePSOCKcluster(detectCores() - 1)
registerDoParallel(clusterCPU)REGRESIÓN LINEAL:
Vamos a probar a hacer una regresión lineal y ver qué resultados obtenemos.
modeloRegresion <- lm(totalPrice1 ~ ., data = datosFinal)
summary(modeloRegresion)##
## Call:
## lm(formula = totalPrice1 ~ ., data = datosFinal)
##
## Residuals:
## Min 1Q Median 3Q Max
## -7.6429 -0.2619 -0.0037 0.2790 2.0031
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 74.0552375 6.8623671 10.792 < 2e-16 ***
## principales 0.1974464 0.0036950 53.436 < 2e-16 ***
## Lng -0.5749861 0.0518222 -11.095 < 2e-16 ***
## Lat -0.0324110 0.0667758 -0.485 0.627428
## seguidores 0.0036525 0.0002722 13.419 < 2e-16 ***
## floor2 -0.6918317 0.1506171 -4.593 4.43e-06 ***
## floor3 -0.6467531 0.1276963 -5.065 4.19e-07 ***
## floor4 -0.6198636 0.1267793 -4.889 1.03e-06 ***
## floor5 -0.8124436 0.1121647 -7.243 4.82e-13 ***
## floor6 -0.7879408 0.1095450 -7.193 6.97e-13 ***
## floor7 -0.8352838 0.1160417 -7.198 6.70e-13 ***
## floor8 -0.7386626 0.1261341 -5.856 4.94e-09 ***
## floor9 -0.8269925 0.1173104 -7.050 1.96e-12 ***
## floor10 -0.8173447 0.1174847 -6.957 3.77e-12 ***
## floor11 -0.7726000 0.1158750 -6.668 2.79e-11 ***
## floor12 -0.7785369 0.1151124 -6.763 1.45e-11 ***
## floor13 -0.6707983 0.1213038 -5.530 3.31e-08 ***
## floor14 -0.7414551 0.1189377 -6.234 4.80e-10 ***
## floor15 -0.8136869 0.1162677 -6.998 2.82e-12 ***
## floor16 -0.5630323 0.1131745 -4.975 6.68e-07 ***
## floor17 -0.6894708 0.1203765 -5.728 1.06e-08 ***
## floor18 -0.7075051 0.1132245 -6.249 4.37e-10 ***
## floor19 -0.5005373 0.1321563 -3.787 0.000153 ***
## floor20 -0.8990264 0.1164722 -7.719 1.33e-14 ***
## floor21 -0.7093459 0.1139611 -6.224 5.10e-10 ***
## floor22 -0.7561527 0.1133081 -6.673 2.68e-11 ***
## floor23 -0.9847664 0.1230706 -8.002 1.42e-15 ***
## floor24 -0.8612335 0.1143063 -7.534 5.49e-14 ***
## floor25 -0.6784129 0.1184127 -5.729 1.05e-08 ***
## floor26 -0.6568068 0.1177255 -5.579 2.50e-08 ***
## floor27 -0.6769570 0.1166975 -5.801 6.87e-09 ***
## floor28 -0.6696878 0.1153781 -5.804 6.73e-09 ***
## floor29 -0.7671202 0.1258624 -6.095 1.15e-09 ***
## floor30 -0.6166576 0.1225569 -5.032 4.98e-07 ***
## floor31 -0.5203644 0.1310886 -3.970 7.27e-05 ***
## floor32 -0.3344728 0.1675879 -1.996 0.045992 *
## floor33 -0.5163688 0.1833264 -2.817 0.004865 **
## floor34 -0.9119618 0.1220944 -7.469 8.98e-14 ***
## floor36 -0.8162887 0.3111657 -2.623 0.008725 **
## floor37 -0.8245558 0.2749860 -2.999 0.002722 **
## floor42 -0.0741378 0.2101404 -0.353 0.724247
## buildingType2 -0.1707440 0.1141162 -1.496 0.134637
## buildingType3 -0.0029696 0.0178143 -0.167 0.867613
## buildingType4 0.0123432 0.0208234 0.593 0.553364
## renovacionCondicion2 0.1117386 0.0390874 2.859 0.004266 **
## renovacionCondicion3 0.2588966 0.0170671 15.169 < 2e-16 ***
## renovacionCondicion4 0.2526873 0.0142648 17.714 < 2e-16 ***
## buildingStrucuture2 0.0441737 0.0590792 0.748 0.454663
## buildingStrucuture3 -0.0392771 0.1078533 -0.364 0.715740
## buildingStrucuture4 0.1951476 0.0670212 2.912 0.003605 **
## buildingStrucuture5 -0.2526393 0.2322415 -1.088 0.276705
## buildingStrucuture6 0.1387514 0.0611327 2.270 0.023256 *
## ascensor1 0.1749279 0.0280278 6.241 4.58e-10 ***
## metro1 0.2688686 0.0129532 20.757 < 2e-16 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 0.5019 on 7401 degrees of freedom
## Multiple R-squared: 0.4156, Adjusted R-squared: 0.4114
## F-statistic: 99.3 on 53 and 7401 DF, p-value: < 2.2e-16Vemos que la variable “buildingType” no es nada significativa para el modelo. Aparte de algún factor de “floor”. Sin embargo el p-value del modelo sí es significativo, al igual que la mayoría de las variables. Pero solamente tiene un R2=41%. Con lo que el modelo es muy flojo.
MODELO LASSO:
set.seed(7)
#Control de la Técnica de Remuestreo: 100 muestras bootstrap
lasso.ctrl = trainControl( method = "boot" , number = 100)
lassoGrid = expand.grid( .alpha = 1 , .lambda = seq( .001 , .1 , length = 20 ))
modelo_lasso <- train(
totalPrice1 ~.,
data = train_prTotal,
method = "glmnet",
preProc = c("center", "scale"),
tuneGrid = lassoGrid,
metric = metrica,
trControl = lasso.ctrl
)
saveRDS(modelo_lasso, "mod_lasso.RDS")MODELO CART:
set.seed(7)
cartGrid <- expand.grid(cp = 0:20/100)
modelo_cart <- train(
totalPrice1 ~.,
data = train_prTotal,
method = "rpart",
metric = metrica,
preProc = c("center", "scale"),
trControl = control,
tuneGrid = cartGrid
)## Warning in nominalTrainWorkflow(x = x, y = y, wts = weights, info = trainInfo,
## : There were missing values in resampled performance measures.saveRDS(modelo_cart, "mod_cart.RDS")RANDOM FOREST:
set.seed(9)
#tune_grid = NULL
# control_oob <- trainControl(method = "oob", verboseIter = FALSE)
tune_grid = expand.grid(
mtry = 11:14,
splitrule = c("variance", "extratrees"),
min.node.size = 5
)
modelo_rf <- train(
totalPrice1 ~.,
data = train_prTotal,
# allowParallel = TRUE,
#method = "rf",
method = "ranger",
metric = "RMSE",
trControl = control,
tuneGrid = tune_grid,
importance = 'impurity'
)
saveRDS(modelo_rf, "mod_rf.RDS")MODELO KNN-VECINOS:
set.seed(7)
knnGrid <- expand.grid(k = 5:15)
modelo_knn <- train(
totalPrice1 ~.,
data = train_prTotal,
method = "knn",
preProc = c("center", "scale"),
metric = metrica,
trControl = control,
tuneGrid = knnGrid
)
saveRDS(modelo_knn, "mod_knn.RDS")MODELO PERCEPTRÓN MULTICAPA:
#library(fastDummies)
# train1 < dummy_cols(train_prTotal, remove_first_dummy = TRUE)
# remove_selected_columns = TRUE
set.seed(7)
mlpGrid <- expand.grid(size = c(4:10), decay = c(0.1,0.9))
modelo_mlp<- train(
totalPrice1 ~.,
data = train_prTotal,
method = "nnet",
metric = metrica,
preProc = c("center", "scale"),
trControl = control,
tuneGrid = mlpGrid,
Linout=TRUE
)## # weights: 551
## initial value 164579.810120
## iter 10 value 135484.124640
## iter 20 value 135010.253476
## final value 135010.074366
## convergedsaveRDS(modelo_mlp, "mod_mlp.RDS")MODELO MÁQUINA SOPORTE VECTORIAL:
# .sigma = c(1:10/100)
set.seed(7)
svmGrid <- expand.grid(
.C = c(1, 1.5,2),
.sigma = c(0.1, 0.01)
)
modelo_svm <- train(
totalPrice1 ~.,
data = train_prTotal,
method = "svmRadial",
metric = metrica,
preProc = c("center", "scale"),
trControl = control,
tuneGrid = svmGrid
)
saveRDS(modelo_svm, "mod_svm.RDS")MODELO DE EMBOLSADO:
set.seed(7)
modelo_bag <- train(
totalPrice1~.,
data = train_prTotal,
method = "treebag",
metric = metrica,
preProc = c("center", "scale"),
trControl = control, verbose = FALSE
)
saveRDS(modelo_bag, "mod_bag.RDS")MODELO AUMENTO DE GRADIENTE:
set.seed(7)
gbmGrid <- expand.grid(
n.trees = c(300, 400, 500),
interaction.depth = c(12, 13, 14),
shrinkage = 0.1,
n.minobsinnode = 10
)
modelo_gbm <- train(
totalPrice1 ~.,
data = train_prTotal,
method = "gbm",
metric = metrica,
preProc = c("center", "scale"),
trControl = control,
tuneGrid = gbmGrid,
verbose = FALSE
)
saveRDS(modelo_gbm, "mod_gbm.RDS")AUMENTO DE GRADIENTE EXTREMO:
set.seed(7)
grid_xgbTree = expand.grid(
nrounds = 500,
eta = c(0.001, 0.3),
max_depth = c(6, 8),
gamma = c(1, 3),
subsample = c(0.75, 1),
min_child_weight = c(2, 3),
colsample_bytree = 1
)
modelo_xgb <- train(
totalPrice1~.,
data = train_prTotal,
method = "xgbTree",
metric = metrica,
preProc = c("center", "scale"),
trControl = control,
tuneGrid = grid_xgbTree
)
saveRDS(modelo_xgb, "mod_xgb.RDS")Resultados de los Modelos:
## Funciones para sacar resultados de los modelos:
mod_lasso <- readRDS("mod_lasso.RDS")
mod_knn <- readRDS("mod_knn.RDS")
mod_cart <- readRDS("mod_cart.RDS")
mod_rf <- readRDS("mod_rf.RDS")
mod_svm <- readRDS("mod_svm.RDS")
mod_bag <- readRDS("mod_bag.RDS")
mod_mlp <- readRDS("mod_mlp.RDS")
mod_gbm <- readRDS("mod_gbm.RDS")
mod_xgb <- readRDS("mod_xgb.RDS")maquetar <- function(x){
ft <- flextable(data = x) %>%
fontsize(size = 10, part = "body") %>%
fontsize(size = 12, part = "header")
ft <- color(ft, color = "darkgreen", part = "header")
return(autofit(ft))
}Tablas y gráficos de los diferentes modelos:
Medidas_Modelo <- function(modelo) {
# train = dummy_cols(train_prTotal, remove_selected_columns = TRUE)
# test = dummy_cols(test_prTotal, remove_selected_columns = TRUE)
pred.train <- as.data.frame(predict(modelo, train_prTotal, type = "raw"))
names(pred.train) <- "Prediccion"
pred.train <- cbind.data.frame(pred.train, Respuesta = train_prTotal$totalPrice1)
R2.train <- R2(pred.train$Prediccion, pred.train$Respuesta)
RMSE.train <- RMSE(pred.train$Prediccion, pred.train$Respuesta)
MAE.train <- MAE(pred.train$Prediccion, pred.train$Respuesta)
pred.test <- as.data.frame(predict(modelo, test_prTotal, type = "raw"))
names(pred.test) <- "Prediccion"
pred.test <- cbind.data.frame(pred.test, Respuesta = test_prTotal$totalPrice1)
R2.test <- R2(pred.test$Prediccion, pred.test$Respuesta)
RMSE.test <- RMSE(pred.test$Prediccion, pred.test$Respuesta)
MAE.test <- MAE(pred.test$Prediccion, pred.test$Respuesta)
Muestra <- c("Entrenamiento", "Test")
R2 <- c(R2.train, R2.test)
RMSE <- c(RMSE.train, RMSE.test)
MAE <- c(MAE.train, MAE.test)
resul <- data.frame(Muestra, R2, RMSE, MAE)
maquetar(resul)
}MODELO LASSO:
maquetar(mod_lasso$results %>% arrange(-Rsquared) %>% head(10)) %>% add_header_lines(values = "Resultados entrenamiento del modelo de Regresión Lineal Lasso ordenados según valor del R2")Resultados entrenamiento del modelo de Regresión Lineal Lasso ordenados según valor del R2 | |||||||
|---|---|---|---|---|---|---|---|
alpha | lambda | RMSE | Rsquared | MAE | RMSESD | RsquaredSD | MAESD |
1 | 0.001000000 | 0.4993248 | 0.4152112 | 0.3388996 | 0.03513218 | 0.03189000 | 0.006493007 |
1 | 0.006210526 | 0.4997609 | 0.4143825 | 0.3392441 | 0.03565302 | 0.03258271 | 0.006769806 |
1 | 0.011421053 | 0.5017238 | 0.4110378 | 0.3411917 | 0.03600311 | 0.03318718 | 0.007027130 |
1 | 0.016631579 | 0.5045546 | 0.4061368 | 0.3442145 | 0.03627415 | 0.03378447 | 0.007266586 |
1 | 0.021842105 | 0.5078809 | 0.4002939 | 0.3477444 | 0.03649792 | 0.03439626 | 0.007457360 |
1 | 0.027052632 | 0.5114221 | 0.3940568 | 0.3513348 | 0.03667446 | 0.03502549 | 0.007612157 |
1 | 0.032263158 | 0.5149845 | 0.3878727 | 0.3547608 | 0.03678377 | 0.03552184 | 0.007743418 |
1 | 0.037473684 | 0.5186156 | 0.3815597 | 0.3581528 | 0.03692904 | 0.03623113 | 0.007935090 |
1 | 0.042684211 | 0.5225472 | 0.3743250 | 0.3617627 | 0.03703944 | 0.03695907 | 0.008124370 |
1 | 0.047894737 | 0.5267318 | 0.3661602 | 0.3655924 | 0.03700732 | 0.03735029 | 0.008217313 |
Medidas_Modelo(mod_lasso)Muestra | R2 | RMSE | MAE |
|---|---|---|---|
Entrenamiento | 0.4173322 | 0.5029964 | 0.3353615 |
Test | 0.3892215 | 0.4961776 | 0.3428753 |
plot(mod_lasso)
plot(varImp(mod_lasso))
Para este modelo LASSO, vemos que las tres variables más importantes son: principales(es decir, el tamaño y espacios de la casa), la reforma de la casa y el que haya metro cerca.
MODELO KNN-VECINOS
maquetar(mod_knn$results %>% arrange(-Rsquared) %>% head(10)) %>%
add_header_lines(values = "Resultados entrenamiento del modelo de K-vecinos ordenados según valor del R2")Resultados entrenamiento del modelo de K-vecinos ordenados según valor del R2 | ||||||
|---|---|---|---|---|---|---|
k | RMSE | Rsquared | MAE | RMSESD | RsquaredSD | MAESD |
5 | 0.4937760 | 0.4471970 | 0.3196267 | 0.03029263 | 0.03074979 | 0.002725247 |
6 | 0.4955760 | 0.4405962 | 0.3224960 | 0.02543760 | 0.02151814 | 0.003159644 |
7 | 0.4970020 | 0.4347546 | 0.3245156 | 0.02734541 | 0.02149558 | 0.002806645 |
8 | 0.4963537 | 0.4347011 | 0.3255765 | 0.02884137 | 0.01964448 | 0.003314983 |
9 | 0.4992322 | 0.4273171 | 0.3289378 | 0.02793539 | 0.01600812 | 0.001842945 |
10 | 0.5027428 | 0.4190159 | 0.3323192 | 0.02796860 | 0.01858243 | 0.001654314 |
11 | 0.5049303 | 0.4133066 | 0.3353511 | 0.03120082 | 0.02362663 | 0.004025109 |
12 | 0.5067954 | 0.4089184 | 0.3370982 | 0.03154396 | 0.02477185 | 0.004622579 |
13 | 0.5077413 | 0.4067148 | 0.3390172 | 0.03317208 | 0.02581856 | 0.004917618 |
14 | 0.5092265 | 0.4030373 | 0.3405741 | 0.03307159 | 0.02386850 | 0.004296971 |
Medidas_Modelo(mod_knn)Muestra | R2 | RMSE | MAE |
|---|---|---|---|
Entrenamiento | 0.6332068 | 0.3992943 | 0.2490379 |
Test | 0.4348650 | 0.4862377 | 0.3171707 |
`
plot(mod_knn)
plot(varImp(mod_knn))
Para el modelo KNN-VECINOS al igual que en el modelo lasso, da más importancia al tamaño y número de estancias, a la reforma que tenga hecha y a que tenga servicio de metro cerca.
MODELO CART
maquetar(mod_cart$results %>% arrange(-Rsquared) %>% head(10)) %>%
add_header_lines(values = "Resultados entrenamiento del modelo CART ordenados según valor del R2")Resultados entrenamiento del modelo CART ordenados según valor del R2 | ||||||
|---|---|---|---|---|---|---|
cp | RMSE | Rsquared | MAE | RMSESD | RsquaredSD | MAESD |
0.00 | 0.4561176 | 0.5330699 | 0.2835052 | 0.04399257 | 0.05132304 | 0.011639833 |
0.01 | 0.5220056 | 0.3732680 | 0.3573564 | 0.03907737 | 0.03746859 | 0.007837437 |
0.02 | 0.5540084 | 0.2928330 | 0.3801575 | 0.03602913 | 0.02250630 | 0.007489522 |
0.03 | 0.5855333 | 0.2104763 | 0.4114109 | 0.03380901 | 0.02316808 | 0.010723533 |
0.04 | 0.5889801 | 0.2012054 | 0.4148332 | 0.03547360 | 0.02037062 | 0.008066666 |
0.05 | 0.5939341 | 0.1878419 | 0.4198816 | 0.04042912 | 0.04400858 | 0.012286341 |
0.06 | 0.5939341 | 0.1878419 | 0.4198816 | 0.04042912 | 0.04400858 | 0.012286341 |
0.07 | 0.6098465 | 0.1433755 | 0.4370132 | 0.03690136 | 0.02177196 | 0.008017033 |
0.08 | 0.6098465 | 0.1433755 | 0.4370132 | 0.03690136 | 0.02177196 | 0.008017033 |
0.09 | 0.6098465 | 0.1433755 | 0.4370132 | 0.03690136 | 0.02177196 | 0.008017033 |
Medidas_Modelo(mod_cart)Muestra | R2 | RMSE | MAE |
|---|---|---|---|
Entrenamiento | 0.7109685 | 0.3542543 | 0.2069465 |
Test | 0.5612421 | 0.4256306 | 0.2805067 |
plot(mod_cart)
plot(varImp(mod_cart))
El modelo CART da más importancia a las variables: tamaño y número de estancias, a la situación del inmueble en la ciudad y al número de seguidores.
RANDOM FOREST
maquetar(mod_rf$results %>% arrange(-Rsquared) %>% head(10)) %>%
add_header_lines(values = "Resultados entrenamiento del modelo Random Forest ordenados según valor del R2")Resultados entrenamiento del modelo Random Forest ordenados según valor del R2 | ||||||||
|---|---|---|---|---|---|---|---|---|
mtry | splitrule | min.node.size | RMSE | Rsquared | MAE | RMSESD | RsquaredSD | MAESD |
14 | variance | 5 | 0.3932020 | 0.6504825 | 0.2351972 | 0.02860972 | 0.04007672 | 0.008452444 |
13 | variance | 5 | 0.3948012 | 0.6484374 | 0.2370153 | 0.02798121 | 0.03938204 | 0.008192287 |
12 | variance | 5 | 0.3964389 | 0.6474424 | 0.2386585 | 0.02827250 | 0.04014519 | 0.008202766 |
11 | variance | 5 | 0.3987860 | 0.6449262 | 0.2410152 | 0.02653840 | 0.03708779 | 0.008102723 |
14 | extratrees | 5 | 0.4300250 | 0.5885064 | 0.2678760 | 0.02048415 | 0.02068966 | 0.007709120 |
13 | extratrees | 5 | 0.4325538 | 0.5853444 | 0.2702101 | 0.02060142 | 0.02003163 | 0.008160807 |
12 | extratrees | 5 | 0.4362643 | 0.5806498 | 0.2734250 | 0.02008255 | 0.01938413 | 0.007792220 |
11 | extratrees | 5 | 0.4412765 | 0.5735376 | 0.2777879 | 0.02030082 | 0.02014833 | 0.007909555 |
Medidas_Modelo(mod_rf)Muestra | R2 | RMSE | MAE |
|---|---|---|---|
Entrenamiento | 0.8823996 | 0.2426708 | 0.1340852 |
Test | 0.6432954 | 0.3804311 | 0.2379775 |
RESULTADOS E HIPERPARÁMETROS DEL MODELO CON R2=65%
mod_rf$finalModel## Ranger result
##
## Call:
## ranger::ranger(dependent.variable.name = ".outcome", data = x, mtry = min(param$mtry, ncol(x)), min.node.size = param$min.node.size, splitrule = as.character(param$splitrule), write.forest = TRUE, probability = classProbs, ...)
##
## Type: Regression
## Number of trees: 500
## Sample size: 5966
## Number of independent variables: 53
## Mtry: 14
## Target node size: 5
## Variable importance mode: impurity
## Splitrule: variance
## OOB prediction error (MSE): 0.1521239
## R squared (OOB): 0.6497003plot(mod_rf)
plot(varImp(mod_rf))
El modelo RANDOM FOREST da más importancia a las variables: principales(tamaño y número de estancias del inmueble), a la situación geográfica dentro de la ciudad de Beijing, al número de seguidores y a que haya servicio de metro cerca del inmueble.
MODELO MÁQUINAS DE SOPORTE VECTORIAL
maquetar(mod_svm$results %>% arrange(-Rsquared) %>% head(10)) %>%
add_header_lines(values = "Resultados entrenamiento del modelo Máquinas de Vectores Soporte ordenados según valor del R2")Resultados entrenamiento del modelo Máquinas de Vectores Soporte ordenados según valor del R2 | |||||||
|---|---|---|---|---|---|---|---|
C | sigma | RMSE | Rsquared | MAE | RMSESD | RsquaredSD | MAESD |
2.0 | 0.10 | 0.4488151 | 0.5363971 | 0.2667384 | 0.04237853 | 0.04117015 | 0.006795660 |
1.5 | 0.10 | 0.4498158 | 0.5345713 | 0.2679389 | 0.04187981 | 0.04017561 | 0.006781833 |
1.0 | 0.10 | 0.4527399 | 0.5298855 | 0.2711416 | 0.04091518 | 0.03787308 | 0.005951516 |
2.0 | 0.01 | 0.4529488 | 0.5280882 | 0.2750574 | 0.04037004 | 0.03683115 | 0.004858022 |
1.5 | 0.01 | 0.4555294 | 0.5229625 | 0.2778219 | 0.03992412 | 0.03579304 | 0.004355122 |
1.0 | 0.01 | 0.4598989 | 0.5143335 | 0.2830447 | 0.03987796 | 0.03553324 | 0.004171472 |
Medidas_Modelo(mod_svm)Muestra | R2 | RMSE | MAE |
|---|---|---|---|
Entrenamiento | 0.6766302 | 0.3765752 | 0.1781236 |
Test | 0.5532377 | 0.4241203 | 0.2612098 |
RESULTADOS E HIPERPARÁMETROS DEL MODELO CON ERROR PRECDICTIVO DE 33%
mod_svm$finalModel## Support Vector Machine object of class "ksvm"
##
## SV type: eps-svr (regression)
## parameter : epsilon = 0.1 cost C = 2
##
## Gaussian Radial Basis kernel function.
## Hyperparameter : sigma = 0.1
##
## Number of Support Vectors : 4803
##
## Objective Function Value : -2771.687
## Training error : 0.326547plot(mod_svm)
plot(varImp(mod_svm))
En el modelo MÁQUINAS DE SOPORTE VECTORIAL las variables más importantes
son: principales(el tamaño y número de estancias del inmueble), la
reforma que tenga hecho el piso y si el metro está cerca del piso.
MODELO PERCEPTRÓN MULTICAPA
maquetar(mod_mlp$results %>% arrange(-Rsquared) %>% head(10)) %>%
add_header_lines(values = "Resultados entrenamiento del modelo Perceptrón Multicapa ordenados según valor del R2")Resultados entrenamiento del modelo Perceptrón Multicapa ordenados según valor del R2 | |||||||
|---|---|---|---|---|---|---|---|
size | decay | RMSE | Rsquared | MAE | RMSESD | RsquaredSD | MAESD |
6 | 0.9 | 4.757117 | 0.3908378 | 4.717909 | 0.008580517 | 0.03119418 | 0.01037696 |
5 | 0.9 | 4.757125 | 0.3902153 | 4.717917 | 0.008580456 | 0.03053710 | 0.01037710 |
4 | 0.1 | 4.757038 | 0.3839220 | 4.717829 | 0.008580438 | 0.03155649 | 0.01037709 |
5 | 0.1 | 4.757037 | 0.3806719 | 4.717827 | 0.008580377 | 0.04028502 | 0.01037702 |
7 | 0.1 | 4.757035 | 0.3792481 | 4.717826 | 0.008580344 | 0.02402229 | 0.01037701 |
9 | 0.1 | 4.757034 | 0.3790672 | 4.717824 | 0.008580405 | 0.02251608 | 0.01037705 |
8 | 0.1 | 4.757034 | 0.3788273 | 4.717825 | 0.008580375 | 0.03796687 | 0.01037704 |
8 | 0.9 | 4.757107 | 0.3689443 | 4.717899 | 0.008580359 | 0.05964617 | 0.01037705 |
10 | 0.1 | 4.757033 | 0.3643443 | 4.717824 | 0.008580324 | 0.03550024 | 0.01037698 |
7 | 0.9 | 4.757112 | 0.3574689 | 4.717904 | 0.008580208 | 0.04422170 | 0.01037664 |
Medidas_Modelo(mod_mlp)Muestra | R2 | RMSE | MAE |
|---|---|---|---|
Entrenamiento | 0.3801551 | 4.757038 | 4.717822 |
Test | 0.3527930 | 4.751760 | 4.710050 |
plot(mod_mlp)
plot(varImp(mod_mlp))
En el modelo PERCEPTRÓN MULTICAPA las variables más relevantes son: principales(tamaño y número de estancias), el metro cerca y reforma y seguidores.
MODELO AUMENTO DE GRADIENTE
maquetar(mod_gbm$results %>% arrange(-Rsquared) %>% head(10)) %>%
add_header_lines(values = "Resultados entrenamiento del modelo GBM ordenados según valor del R2")Resultados entrenamiento del modelo GBM ordenados según valor del R2 | |||||||||
|---|---|---|---|---|---|---|---|---|---|
shrinkage | interaction.depth | n.minobsinnode | n.trees | RMSE | Rsquared | MAE | RMSESD | RsquaredSD | MAESD |
0.1 | 14 | 10 | 300 | 0.4022086 | 0.6307544 | 0.2399222 | 0.03607888 | 0.05578952 | 0.008131146 |
0.1 | 13 | 10 | 300 | 0.4038943 | 0.6279104 | 0.2403791 | 0.03577380 | 0.05316905 | 0.005568673 |
0.1 | 12 | 10 | 300 | 0.4047602 | 0.6265868 | 0.2399381 | 0.02903291 | 0.04676432 | 0.003149363 |
0.1 | 14 | 10 | 400 | 0.4081402 | 0.6226050 | 0.2409595 | 0.03575345 | 0.06150495 | 0.007425353 |
0.1 | 13 | 10 | 400 | 0.4078785 | 0.6225817 | 0.2404372 | 0.03398930 | 0.05380105 | 0.004354197 |
0.1 | 12 | 10 | 400 | 0.4088836 | 0.6208225 | 0.2405801 | 0.02755276 | 0.04995060 | 0.002851929 |
0.1 | 14 | 10 | 500 | 0.4116312 | 0.6192628 | 0.2410421 | 0.03561018 | 0.06451432 | 0.005552533 |
0.1 | 12 | 10 | 500 | 0.4125284 | 0.6169301 | 0.2417431 | 0.02908956 | 0.05432339 | 0.002657209 |
0.1 | 13 | 10 | 500 | 0.4130165 | 0.6156390 | 0.2407183 | 0.03431049 | 0.05799830 | 0.004328114 |
Medidas_Modelo(mod_gbm)Muestra | R2 | RMSE | MAE |
|---|---|---|---|
Entrenamiento | 0.8219256 | 0.2804709 | 0.1852340 |
Test | 0.6013434 | 0.4039350 | 0.2474449 |
plot(mod_gbm)
plot(varImp(mod_gbm))
En el modelo AUMENTO DE GRADIENTE las variables más importantes son: principales(tamaño y número de estancias), la situación geográfica del inmueble en la ciudad y los seguidores.
MODELO AUMENTO DE GRADIENTE EXTREMO
maquetar(mod_xgb$results %>% arrange(-Rsquared) %>% head(10)) %>%
add_header_lines(values = "Resultados entrenamiento del modelo XGB ordenados según valor del R2")Resultados entrenamiento del modelo XGB ordenados según valor del R2 | ||||||||||||
|---|---|---|---|---|---|---|---|---|---|---|---|---|
eta | max_depth | gamma | colsample_bytree | min_child_weight | subsample | nrounds | RMSE | Rsquared | MAE | RMSESD | RsquaredSD | MAESD |
0.3 | 8 | 1 | 1 | 2 | 1.00 | 500 | 0.4122358 | 0.6099110 | 0.2525488 | 0.03416937 | 0.05472612 | 0.007313299 |
0.3 | 8 | 1 | 1 | 3 | 1.00 | 500 | 0.4121747 | 0.6097138 | 0.2520889 | 0.04140987 | 0.06059322 | 0.007518847 |
0.3 | 6 | 1 | 1 | 3 | 1.00 | 500 | 0.4135047 | 0.6067401 | 0.2527841 | 0.04405770 | 0.05598636 | 0.006866601 |
0.3 | 6 | 1 | 1 | 2 | 1.00 | 500 | 0.4193739 | 0.5967460 | 0.2543866 | 0.03630842 | 0.05421955 | 0.005439417 |
0.3 | 8 | 3 | 1 | 3 | 0.75 | 500 | 0.4234210 | 0.5948196 | 0.2562851 | 0.03155838 | 0.06281631 | 0.007175733 |
0.3 | 8 | 3 | 1 | 3 | 1.00 | 500 | 0.4249588 | 0.5862453 | 0.2692465 | 0.03379610 | 0.05152758 | 0.006670986 |
0.3 | 8 | 3 | 1 | 2 | 1.00 | 500 | 0.4247086 | 0.5861229 | 0.2668284 | 0.03354527 | 0.05190519 | 0.008281536 |
0.3 | 6 | 3 | 1 | 3 | 0.75 | 500 | 0.4290521 | 0.5837679 | 0.2594351 | 0.03030656 | 0.05739600 | 0.006121072 |
0.3 | 6 | 3 | 1 | 2 | 1.00 | 500 | 0.4266926 | 0.5833222 | 0.2661418 | 0.04066953 | 0.05304475 | 0.006987707 |
0.3 | 6 | 1 | 1 | 3 | 0.75 | 500 | 0.4338962 | 0.5832734 | 0.2532040 | 0.03362825 | 0.06234123 | 0.006437656 |
Medidas_Modelo(mod_xgb)Muestra | R2 | RMSE | MAE |
|---|---|---|---|
Entrenamiento | 0.7878063 | 0.3061438 | 0.2076107 |
Test | 0.6102840 | 0.3971433 | 0.2516091 |
plot(mod_xgb)
plot(varImp(mod_xgb))
En el modelo AUMENTO DE GRADIENTE EXTREMO las variables más importantes son: principales(tamaño y número de estancias), la situación geográfica del inmueble en la ciudad y los seguidores.
MODELO DE EMBOLSADO
maquetar(mod_bag$results %>% arrange(-Rsquared) %>% head(10)) %>%
add_header_lines(values = "Resultados entrenamiento del modelo Bagging ordenados según valor del R2")Resultados entrenamiento del modelo Bagging ordenados según valor del R2 | ||||||
|---|---|---|---|---|---|---|
parameter | RMSE | Rsquared | MAE | RMSESD | RsquaredSD | MAESD |
none | 0.4861056 | 0.4677843 | 0.3246993 | 0.03798871 | 0.032677 | 0.007437739 |
Medidas_Modelo(mod_bag)Muestra | R2 | RMSE | MAE |
|---|---|---|---|
Entrenamiento | 0.4866879 | 0.4779342 | 0.3237993 |
Test | 0.4576539 | 0.4700950 | 0.3299333 |
plot(varImp(mod_bag))
En el método de EMBOLSADO las variables más importantes son: la situación geográfica del inmueble, el tamaño y número de estancias del piso y el número de seguidores en la página.
Contrastación y comparación de modelos
Puede verse que, todos los modelos, consiguen más predicciones correctas en el conjunto de entrenamiento que en el de test.
resultados<- resamples(
list(
CART = modelo_cart,
KNN = modelo_knn,
RED_NEURONAL = modelo_mlp,
SVM = modelo_svm,
RF = modelo_rf,
GBM = modelo_gbm,
BAG = modelo_bag,
XGB = modelo_xgb
)
)
summary(resultados)##
## Call:
## summary.resamples(object = resultados)
##
## Models: CART, KNN, RED_NEURONAL, SVM, RF, GBM, BAG, XGB
## Number of resamples: 5
##
## MAE
## Min. 1st Qu. Median Mean 3rd Qu. Max. NA's
## CART 0.2676430 0.2777558 0.2827347 0.2835052 0.2929360 0.2964568 0
## KNN 0.3167844 0.3180781 0.3184006 0.3196267 0.3214475 0.3234231 0
## RED_NEURONAL 4.7062768 4.7109202 4.7146379 4.7178240 4.7269846 4.7303003 0
## SVM 0.2552670 0.2675375 0.2680664 0.2667384 0.2695301 0.2732909 0
## RF 0.2243935 0.2325053 0.2339814 0.2351972 0.2374479 0.2476578 0
## GBM 0.2332825 0.2352414 0.2364807 0.2399222 0.2410718 0.2535347 0
## BAG 0.3161005 0.3180499 0.3263039 0.3246993 0.3295874 0.3334547 0
## XGB 0.2431158 0.2449467 0.2559028 0.2520889 0.2567571 0.2597222 0
##
## RMSE
## Min. 1st Qu. Median Mean 3rd Qu. Max. NA's
## CART 0.3831595 0.4576083 0.4667851 0.4561176 0.4714483 0.5015869 0
## KNN 0.4463051 0.4823160 0.5053507 0.4937760 0.5135499 0.5213581 0
## RED_NEURONAL 4.7478812 4.7515752 4.7535848 4.7570333 4.7643329 4.7677925 0
## SVM 0.3741546 0.4601022 0.4623475 0.4488151 0.4683979 0.4790732 0
## RF 0.3567157 0.3802024 0.3947192 0.3932020 0.3995650 0.4348077 0
## GBM 0.3687649 0.3698589 0.3987087 0.4022086 0.4191249 0.4545856 0
## BAG 0.4194034 0.4958835 0.4971132 0.4861056 0.5039437 0.5141842 0
## XGB 0.3605979 0.3881667 0.4068838 0.4121747 0.4398817 0.4653432 0
##
## Rsquared
## Min. 1st Qu. Median Mean 3rd Qu. Max. NA's
## CART 0.4638140 0.5230905 0.5322916 0.5330699 0.5381585 0.6079949 0
## KNN 0.4176744 0.4185847 0.4469550 0.4471970 0.4624577 0.4903132 0
## RED_NEURONAL 0.3165308 0.3407792 0.3704442 0.3643443 0.3929993 0.4009682 0
## SVM 0.5003784 0.5167450 0.5263732 0.5363971 0.5315747 0.6069141 0
## RF 0.5963940 0.6331227 0.6535201 0.6504825 0.6640914 0.7052841 0
## GBM 0.5502752 0.6080301 0.6411983 0.6307544 0.6542720 0.6999963 0
## BAG 0.4339043 0.4519622 0.4590398 0.4677843 0.4736784 0.5203366 0
## XGB 0.5265524 0.5665798 0.6400033 0.6097138 0.6438644 0.6715692 0EL MODELO QUE DA MEJORES RESULTADOS ES EL RANDOM FOREST CON UN MÁXIMO R2=0.71, Y EL PEOR MODELO ES LA RED NEURONAL CON UN MÁXIMO R2=0.40
dotplot(resultados, scales = list(relation = "free"))
EN LA GRÁFICA SE COMPRUEBA LO QUE HEMOS AFIRMADO HACE UN MOMENTO, EL MODELO RANDOM FOREST ES EL QUE MEJOR AJUSTA, MUY SEGUIDO DEL MODELO DE AUMENTO DE GRADIENTE. Y EL PEOR MODELO EL DE LA RED NEURONAL.
A CONTINUACIÓN VEMOS LAS DIFERENCIAS MÉTRICAS ENTRE LOS DISTINTOS MÉTODOS UTILIZADOS:
diferencias <- diff(resultados)
summary(diferencias)##
## Call:
## summary.diff.resamples(object = diferencias)
##
## p-value adjustment: bonferroni
## Upper diagonal: estimates of the difference
## Lower diagonal: p-value for H0: difference = 0
##
## MAE
## CART KNN RED_NEURONAL SVM RF GBM
## CART -0.036121 -4.434319 0.016767 0.048308 0.043583
## KNN 0.0542600 -4.398197 0.052888 0.084430 0.079705
## RED_NEURONAL 2.324e-09 4.627e-10 4.451086 4.482627 4.477902
## SVM 0.3474392 0.0012058 7.570e-10 0.031541 0.026816
## RF 0.0561362 0.0002252 1.522e-09 0.1051787 -0.004725
## GBM 0.0034458 0.0005038 9.824e-10 0.0598131 1.0000000
## BAG 0.0472050 1.0000000 6.657e-10 0.0005211 0.0030424 0.0031778
## XGB 0.0212242 0.0003773 1.553e-09 0.3703976 0.2149967 0.1908072
## BAG XGB
## CART -0.041194 0.031416
## KNN -0.005073 0.067538
## RED_NEURONAL 4.393125 4.465735
## SVM -0.057961 0.014649
## RF -0.089502 -0.016892
## GBM -0.084777 -0.012167
## BAG 0.072610
## XGB 0.0031303
##
## RMSE
## CART KNN RED_NEURONAL SVM RF GBM
## CART -0.037658 -4.300916 0.007303 0.062916 0.053909
## KNN 0.560982 -4.263257 0.044961 0.100574 0.091567
## RED_NEURONAL 1.247e-07 3.709e-08 4.308218 4.363831 4.354825
## SVM 1.000000 0.265305 1.022e-07 0.055613 0.046606
## RF 1.000000 0.432684 6.019e-09 1.000000 -0.009007
## GBM 0.600247 0.012404 5.608e-08 1.000000 1.000000
## BAG 0.498475 1.000000 7.179e-08 0.001356 0.848278 0.183762
## XGB 0.646161 0.012370 1.011e-07 1.000000 1.000000 1.000000
## BAG XGB
## CART -0.029988 0.043943
## KNN 0.007670 0.081601
## RED_NEURONAL 4.270928 4.344859
## SVM -0.037291 0.036640
## RF -0.092904 -0.018973
## GBM -0.083897 -0.009966
## BAG 0.073931
## XGB 0.190190
##
## Rsquared
## CART KNN RED_NEURONAL SVM RF GBM
## CART 0.085873 0.168726 -0.003327 -0.117413 -0.097685
## KNN 0.441574 0.082853 -0.089200 -0.203285 -0.183557
## RED_NEURONAL 0.171179 0.432542 -0.172053 -0.286138 -0.266410
## SVM 1.000000 0.252512 0.069048 -0.114085 -0.094357
## RF 1.000000 0.042304 0.006403 0.824325 0.019728
## GBM 0.451379 0.005421 0.023420 0.849945 1.000000
## BAG 0.391866 1.000000 0.220747 0.003857 0.110369 0.091765
## XGB 0.780713 0.012693 0.055047 1.000000 1.000000 1.000000
## BAG XGB
## CART 0.065286 -0.076644
## KNN -0.020587 -0.162517
## RED_NEURONAL -0.103440 -0.245369
## SVM 0.068613 -0.073317
## RF 0.182698 0.040769
## GBM 0.162970 0.021041
## BAG -0.141930
## XGB 0.148923Las mayores diferencias se dan entre RANDOM FOREST y REDES NEURONALES como cabía esperar por sus respectivos resultados.
tabla_resultados<-resultados$values %>% head(10)
kable(tabla_resultados)| Resample | CART~MAE | CART~RMSE | CART~Rsquared | KNN~MAE | KNN~RMSE | KNN~Rsquared | RED_NEURONAL~MAE | RED_NEURONAL~RMSE | RED_NEURONAL~Rsquared | SVM~MAE | SVM~RMSE | SVM~Rsquared | RF~MAE | RF~RMSE | RF~Rsquared | GBM~MAE | GBM~RMSE | GBM~Rsquared | BAG~MAE | BAG~RMSE | BAG~Rsquared | XGB~MAE | XGB~RMSE | XGB~Rsquared |
|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|
| Fold1.Rep1 | 0.2777558 | 0.4576083 | 0.5381585 | 0.3234231 | 0.5135499 | 0.4185847 | 4.706277 | 4.747881 | 0.3929993 | 0.2680664 | 0.4601022 | 0.5263732 | 0.2476578 | 0.3995650 | 0.6331227 | 0.2364807 | 0.4191249 | 0.6080301 | 0.3263039 | 0.4958835 | 0.4590398 | 0.2559028 | 0.4398817 | 0.5665798 |
| Fold2.Rep1 | 0.2676430 | 0.3831595 | 0.6079949 | 0.3167844 | 0.4463051 | 0.4624577 | 4.730300 | 4.767792 | 0.3407792 | 0.2552670 | 0.3741546 | 0.6069141 | 0.2339814 | 0.4348077 | 0.5963940 | 0.2332825 | 0.3687649 | 0.6411983 | 0.3161005 | 0.4194034 | 0.5203366 | 0.2431158 | 0.3605979 | 0.6438644 |
| Fold3.Rep1 | 0.2827347 | 0.4667851 | 0.5322916 | 0.3180781 | 0.5053507 | 0.4469550 | 4.726985 | 4.764333 | 0.3165308 | 0.2732909 | 0.4790732 | 0.5003784 | 0.2243935 | 0.3947192 | 0.6640914 | 0.2352414 | 0.3987087 | 0.6542720 | 0.3334547 | 0.5141842 | 0.4339043 | 0.2449467 | 0.4068838 | 0.6400033 |
| Fold4.Rep1 | 0.2929360 | 0.4714483 | 0.5230905 | 0.3184006 | 0.4823160 | 0.4903132 | 4.710920 | 4.753585 | 0.4009682 | 0.2675375 | 0.4623475 | 0.5315747 | 0.2325053 | 0.3802024 | 0.6535201 | 0.2410718 | 0.3698589 | 0.6999963 | 0.3295874 | 0.4971132 | 0.4736784 | 0.2567571 | 0.3881667 | 0.6715692 |
| Fold5.Rep1 | 0.2964568 | 0.5015869 | 0.4638140 | 0.3214475 | 0.5213581 | 0.4176744 | 4.714638 | 4.751575 | 0.3704442 | 0.2695301 | 0.4683979 | 0.5167450 | 0.2374479 | 0.3567157 | 0.7052841 | 0.2535347 | 0.4545856 | 0.5502752 | 0.3180499 | 0.5039437 | 0.4519622 | 0.2597222 | 0.4653432 | 0.5265524 |
library(tidyverse)## ── Attaching core tidyverse packages ──────────────────────── tidyverse 2.0.0 ──
## ✔ forcats 1.0.0 ✔ readr 2.1.4
## ✔ lubridate 1.9.2 ✔ stringr 1.5.0
## ✔ purrr 1.0.1 ✔ tidyr 1.3.0
## ── Conflicts ────────────────────────────────────────── tidyverse_conflicts() ──
## ✖ psych::%+%() masks ggplot2::%+%()
## ✖ purrr::accumulate() masks foreach::accumulate()
## ✖ tidytable::across() masks dplyr::across()
## ✖ tidytable::add_count() masks dplyr::add_count()
## ✖ tidytable::add_tally() masks dplyr::add_tally()
## ✖ psych::alpha() masks ggplot2::alpha()
## ✖ tidytable::anti_join() masks dplyr::anti_join()
## ✖ tidytable::arrange() masks dplyr::arrange()
## ✖ tidytable::between() masks data.table::between(), dplyr::between()
## ✖ tidytable::bind_cols() masks dplyr::bind_cols()
## ✖ tidytable::bind_rows() masks dplyr::bind_rows()
## ✖ tidytable::c_across() masks dplyr::c_across()
## ✖ tidytable::case_match() masks dplyr::case_match()
## ✖ tidytable::case_when() masks dplyr::case_when()
## ✖ tidytable::coalesce() masks dplyr::coalesce()
## ✖ randomForest::combine() masks dplyr::combine()
## ✖ tidyr::complete() masks mice::complete(), tidytable::complete()
## ✖ purrr::compose() masks flextable::compose()
## ✖ tidytable::consecutive_id() masks dplyr::consecutive_id()
## ✖ tidytable::count() masks dplyr::count()
## ✖ tidytable::cross_join() masks dplyr::cross_join()
## ✖ tidyr::crossing() masks tidytable::crossing()
## ✖ tidytable::cume_dist() masks dplyr::cume_dist()
## ✖ tidytable::cur_column() masks dplyr::cur_column()
## ✖ tidytable::cur_data() masks dplyr::cur_data()
## ✖ tidytable::cur_group_id() masks dplyr::cur_group_id()
## ✖ tidytable::cur_group_rows() masks dplyr::cur_group_rows()
## ✖ tidytable::dense_rank() masks dplyr::dense_rank()
## ✖ tidytable::desc() masks dplyr::desc()
## ✖ tidytable::distinct() masks dplyr::distinct()
## ✖ tidyr::drop_na() masks tidytable::drop_na()
## ✖ tibble::enframe() masks tidytable::enframe()
## ✖ tidyr::expand() masks tidytable::expand()
## ✖ tidyr::expand_grid() masks tidytable::expand_grid()
## ✖ DALEX::explain() masks dplyr::explain()
## ✖ tidyr::extract() masks tidytable::extract(), dlookr::extract()
## ✖ tidyr::fill() masks tidytable::fill()
## ✖ mice::filter() masks tidytable::filter(), dplyr::filter(), stats::filter()
## ✖ xts::first() masks tidytable::first(), data.table::first(), dplyr::first()
## ✖ tidytable::full_join() masks dplyr::full_join()
## ✖ tidytable::group_by() masks dplyr::group_by()
## ✖ tidytable::group_cols() masks dplyr::group_cols()
## ✖ dplyr::group_rows() masks kableExtra::group_rows()
## ✖ tidytable::group_split() masks dplyr::group_split()
## ✖ tidytable::group_vars() masks dplyr::group_vars()
## ✖ lubridate::hour() masks data.table::hour()
## ✖ tidytable::if_all() masks dplyr::if_all()
## ✖ tidytable::if_any() masks dplyr::if_any()
## ✖ tidytable::if_else() masks dplyr::if_else()
## ✖ tidytable::inner_join() masks dplyr::inner_join()
## ✖ tidytable::is_grouped_df() masks dplyr::is_grouped_df()
## ✖ lubridate::isoweek() masks data.table::isoweek()
## ✖ tidytable::lag() masks dplyr::lag(), stats::lag()
## ✖ xts::last() masks tidytable::last(), data.table::last(), dplyr::last()
## ✖ tidytable::lead() masks dplyr::lead()
## ✖ tidytable::left_join() masks dplyr::left_join()
## ✖ purrr::lift() masks caret::lift()
## ✖ purrr::map() masks tidytable::map()
## ✖ purrr::map_chr() masks tidytable::map_chr()
## ✖ purrr::map_dbl() masks tidytable::map_dbl()
## ✖ purrr::map_df() masks tidytable::map_df()
## ✖ purrr::map_dfc() masks tidytable::map_dfc()
## ✖ purrr::map_dfr() masks tidytable::map_dfr()
## ✖ purrr::map_int() masks tidytable::map_int()
## ✖ purrr::map_lgl() masks tidytable::map_lgl()
## ✖ purrr::map_vec() masks tidytable::map_vec()
## ✖ purrr::map2() masks tidytable::map2()
## ✖ purrr::map2_chr() masks tidytable::map2_chr()
## ✖ purrr::map2_dbl() masks tidytable::map2_dbl()
## ✖ purrr::map2_df() masks tidytable::map2_df()
## ✖ purrr::map2_dfc() masks tidytable::map2_dfc()
## ✖ purrr::map2_dfr() masks tidytable::map2_dfr()
## ✖ purrr::map2_int() masks tidytable::map2_int()
## ✖ purrr::map2_lgl() masks tidytable::map2_lgl()
## ✖ purrr::map2_vec() masks tidytable::map2_vec()
## ✖ randomForest::margin() masks ggplot2::margin()
## ✖ lubridate::mday() masks data.table::mday()
## ✖ tidytable::min_rank() masks dplyr::min_rank()
## ✖ lubridate::minute() masks data.table::minute()
## ✖ lubridate::month() masks data.table::month()
## ✖ tidytable::mutate() masks dplyr::mutate()
## ✖ tidytable::n() masks dplyr::n()
## ✖ tidytable::n_distinct() masks dplyr::n_distinct()
## ✖ tidytable::na_if() masks dplyr::na_if()
## ✖ tidyr::nest() masks tidytable::nest()
## ✖ tidytable::nest_by() masks dplyr::nest_by()
## ✖ tidytable::nest_join() masks dplyr::nest_join()
## ✖ tidyr::nesting() masks tidytable::nesting()
## ✖ tidytable::nth() masks dplyr::nth()
## ✖ tidytable::pick() masks dplyr::pick()
## ✖ tidyr::pivot_longer() masks tidytable::pivot_longer()
## ✖ tidyr::pivot_wider() masks tidytable::pivot_wider()
## ✖ purrr::pmap() masks tidytable::pmap()
## ✖ purrr::pmap_chr() masks tidytable::pmap_chr()
## ✖ purrr::pmap_dbl() masks tidytable::pmap_dbl()
## ✖ purrr::pmap_df() masks tidytable::pmap_df()
## ✖ purrr::pmap_dfc() masks tidytable::pmap_dfc()
## ✖ purrr::pmap_dfr() masks tidytable::pmap_dfr()
## ✖ purrr::pmap_int() masks tidytable::pmap_int()
## ✖ purrr::pmap_lgl() masks tidytable::pmap_lgl()
## ✖ purrr::pmap_vec() masks tidytable::pmap_vec()
## ✖ tidytable::pull() masks dplyr::pull()
## ✖ lubridate::quarter() masks data.table::quarter()
## ✖ tidytable::recode() masks car::recode(), dplyr::recode()
## ✖ tidytable::reframe() masks dplyr::reframe()
## ✖ tidytable::relocate() masks dplyr::relocate()
## ✖ tidytable::rename() masks dplyr::rename()
## ✖ tidytable::rename_with() masks dplyr::rename_with()
## ✖ tidyr::replace_na() masks tidytable::replace_na()
## ✖ tidytable::right_join() masks dplyr::right_join()
## ✖ tidytable::row_number() masks dplyr::row_number()
## ✖ tidytable::rowwise() masks dplyr::rowwise()
## ✖ lubridate::second() masks data.table::second()
## ✖ MASS::select() masks tidytable::select(), dplyr::select()
## ✖ tidytable::semi_join() masks dplyr::semi_join()
## ✖ tidyr::separate() masks tidytable::separate()
## ✖ tidyr::separate_longer_delim() masks tidytable::separate_longer_delim()
## ✖ tidyr::separate_rows() masks tidytable::separate_rows()
## ✖ tidyr::separate_wider_delim() masks tidytable::separate_wider_delim()
## ✖ tidyr::separate_wider_regex() masks tidytable::separate_wider_regex()
## ✖ tidytable::slice() masks dplyr::slice()
## ✖ tidytable::slice_head() masks dplyr::slice_head()
## ✖ tidytable::slice_max() masks dplyr::slice_max()
## ✖ tidytable::slice_min() masks dplyr::slice_min()
## ✖ tidytable::slice_sample() masks dplyr::slice_sample()
## ✖ tidytable::slice_tail() masks dplyr::slice_tail()
## ✖ purrr::some() masks car::some()
## ✖ Hmisc::src() masks dplyr::src()
## ✖ tidytable::summarise() masks dplyr::summarise()
## ✖ Hmisc::summarize() masks tidytable::summarize(), dplyr::summarize()
## ✖ tidytable::tally() masks dplyr::tally()
## ✖ tidytable::top_n() masks dplyr::top_n()
## ✖ tidytable::transmute() masks dplyr::transmute()
## ✖ purrr::transpose() masks data.table::transpose()
## ✖ tidyr::tribble() masks tibble::tribble(), tidytable::tribble(), dplyr::tribble()
## ✖ tidyr::uncount() masks tidytable::uncount()
## ✖ tidytable::ungroup() masks dplyr::ungroup()
## ✖ tidyr::unite() masks tidytable::unite()
## ✖ tidyr::unnest() masks tidytable::unnest()
## ✖ tidyr::unnest_longer() masks tidytable::unnest_longer()
## ✖ tidyr::unnest_wider() masks tidytable::unnest_wider()
## ✖ purrr::walk() masks tidytable::walk()
## ✖ lubridate::wday() masks data.table::wday()
## ✖ lubridate::week() masks data.table::week()
## ✖ purrr::when() masks foreach::when()
## ✖ lubridate::yday() masks data.table::yday()
## ✖ lubridate::year() masks data.table::year()
## ℹ Use the conflicted package (<http://conflicted.r-lib.org/>) to force all conflicts to become errorsmetricas <- resultados$values %>%
gather(key = "modelo", value = "valor", -Resample) %>%
separate(col = "modelo", into = c("modelo", "metrica"),
sep = "~", remove = TRUE)
metricas %>% head(10)| Resample | modelo | metrica | valor |
|---|---|---|---|
| Fold1.Rep1 | CART | MAE | 0.2777558 |
| Fold2.Rep1 | CART | MAE | 0.2676430 |
| Fold3.Rep1 | CART | MAE | 0.2827347 |
| Fold4.Rep1 | CART | MAE | 0.2929360 |
| Fold5.Rep1 | CART | MAE | 0.2964568 |
| Fold1.Rep1 | CART | RMSE | 0.4576083 |
| Fold2.Rep1 | CART | RMSE | 0.3831595 |
| Fold3.Rep1 | CART | RMSE | 0.4667851 |
| Fold4.Rep1 | CART | RMSE | 0.4714483 |
| Fold5.Rep1 | CART | RMSE | 0.5015869 |
COMPARACIÓN MÉTRICAS
tabla_modelos<-metricas %>%
group_by(modelo, metrica) %>%
summarise(media = mean(valor)) %>%
spread(key = metrica, value = media) %>%
arrange(desc(Rsquared))
kable(tabla_modelos)| modelo | MAE | RMSE | Rsquared |
|---|---|---|---|
| RF | 0.2351972 | 0.3932020 | 0.6504825 |
| GBM | 0.2399222 | 0.4022086 | 0.6307544 |
| XGB | 0.2520889 | 0.4121747 | 0.6097138 |
| SVM | 0.2667384 | 0.4488151 | 0.5363971 |
| CART | 0.2835052 | 0.4561176 | 0.5330699 |
| BAG | 0.3246993 | 0.4861056 | 0.4677843 |
| KNN | 0.3196267 | 0.4937760 | 0.4471970 |
| RED_NEURONAL | 4.7178240 | 4.7570333 | 0.3643443 |
metricas %>%
filter(metrica == "Rsquared") %>%
group_by(modelo) %>%
summarise(media = mean(valor)) %>%
ggplot(aes(x = reorder(modelo, media), y = media, label = round(media, 2))) +
geom_segment(aes(x = reorder(modelo, media), y = 0,
xend = modelo, yend = media),
color = "grey50") +
geom_point(size = 7, color = "firebrick") +
geom_text(color = "white", size = 2.5) +
scale_y_continuous(limits = c(0, 1)) +
#Rsquared basal
geom_hline(yintercept = 0.62, linetype = "dashed") +
annotate(geom = "text", y = 0.72, x = 8.5, label = "Rsquared") +
labs(title = "Validación: Rsquared medio repeated-CV",
subtitle = "Modelos ordenados por media",
x = "modelo") +
coord_flip() +
theme_bw()
VEMOS DE MANERA GRÁFICA LO QUE HEMOS ESTADO REPRESENTANDO EN LAS TABLAS ANTERIORES, Y TAMBIÉN LOS RESULTADOS DE LA APLICACIÓN DE DIFERENTES MODELOS. NOS QUEDAMOS CON LOS DOS MEJORES MODELOS: “RANDOM FOREST” Y “AUMENTO DE GRADIENTE”
TABLA COMPARATIVA ENTRE LOS DOS MEJORES MODELOS
# Aquí mostramos una tabla con lo que describimos arriba:
var_imp_rf=data.frame(varImp(modelo_rf, scale=T)["importance"]) %>%
dplyr::mutate(variable=rownames(.)) %>% dplyr::rename(importance_rf=Overall) %>%
dplyr::arrange(-importance_rf) %>%
dplyr::mutate(rank_rf=seq(1:nrow(.)))
var_imp_gbm=as.data.frame(varImp(modelo_gbm, scale=T)["importance"]) %>%
dplyr::mutate(variable=rownames(.)) %>% dplyr::rename(importance_gbm=Overall) %>%
dplyr::arrange(-importance_gbm) %>%
dplyr::mutate(rank_gbm=seq(1:nrow(.)))
final_res=merge(var_imp_rf, var_imp_gbm, by="variable")
final_res$rank_diff=final_res$rank_rf-final_res$rank_gbm
kable(final_res)| variable | importance_rf | rank_rf | importance_gbm | rank_gbm | rank_diff |
|---|---|---|---|---|---|
| ascensor1 | 4.5035596 | 7 | 4.3181893 | 7 | 0 |
| buildingStrucuture2 | 3.4508272 | 8 | 4.3118479 | 8 | 0 |
| buildingStrucuture3 | 0.7284224 | 27 | 0.1393729 | 34 | -7 |
| buildingStrucuture4 | 0.5397661 | 36 | 0.2007249 | 25 | 11 |
| buildingStrucuture5 | 0.0357842 | 50 | 0.0000000 | 53 | -3 |
| buildingStrucuture6 | 3.0117316 | 9 | 1.0379019 | 14 | -5 |
| buildingType2 | 0.2466139 | 45 | 0.2120645 | 23 | 22 |
| buildingType3 | 2.3657130 | 13 | 0.6943403 | 16 | -3 |
| buildingType4 | 2.7232136 | 11 | 1.0490650 | 13 | -2 |
| floor10 | 0.4403207 | 39 | 0.0321743 | 43 | -4 |
| floor11 | 0.6085403 | 33 | 0.1422474 | 32 | 1 |
| floor12 | 1.5098768 | 17 | 0.4508269 | 17 | 0 |
| floor13 | 0.5431241 | 35 | 0.2566470 | 19 | 16 |
| floor14 | 0.4483116 | 38 | 0.1073565 | 37 | 1 |
| floor15 | 0.6689872 | 30 | 0.2069473 | 24 | 6 |
| floor16 | 1.8381255 | 15 | 0.7535442 | 15 | 0 |
| floor17 | 0.5500640 | 34 | 0.1694319 | 28 | 6 |
| floor18 | 0.9374118 | 22 | 0.1507950 | 29 | -7 |
| floor19 | 0.4070872 | 42 | 0.0330331 | 42 | 0 |
| floor2 | 0.4164141 | 40 | 0.0269158 | 45 | -5 |
| floor20 | 1.9277945 | 14 | 2.9833655 | 9 | 5 |
| floor21 | 0.9445132 | 21 | 1.2678311 | 12 | 9 |
| floor22 | 1.6108002 | 16 | 0.0951833 | 38 | -22 |
| floor23 | 1.1348313 | 19 | 0.2354824 | 21 | -2 |
| floor24 | 1.1437037 | 18 | 0.1413052 | 33 | -15 |
| floor25 | 0.8247106 | 25 | 0.1841988 | 27 | -2 |
| floor26 | 0.7176827 | 28 | 0.1359194 | 35 | -7 |
| floor27 | 0.6476744 | 31 | 0.1469547 | 31 | 0 |
| floor28 | 0.6462636 | 32 | 0.2505689 | 20 | 12 |
| floor29 | 0.1920524 | 46 | 0.0283250 | 44 | 2 |
| floor3 | 0.5074720 | 37 | 0.0857774 | 39 | -2 |
| floor30 | 0.3727189 | 43 | 0.0792108 | 40 | 3 |
| floor31 | 0.1655004 | 48 | 0.0519607 | 41 | 7 |
| floor32 | 0.2477272 | 44 | 0.0244229 | 46 | -2 |
| floor33 | 0.0252322 | 51 | 0.0000000 | 48 | 3 |
| floor34 | 0.6741037 | 29 | 0.0000000 | 49 | -20 |
| floor36 | 0.0000000 | 53 | 0.0000000 | 50 | 3 |
| floor37 | 0.0015916 | 52 | 0.0000000 | 51 | 1 |
| floor4 | 0.1717846 | 47 | 0.0103447 | 47 | 0 |
| floor42 | 0.1431126 | 49 | 0.0000000 | 52 | -3 |
| floor5 | 0.7324094 | 26 | 0.1883520 | 26 | 0 |
| floor6 | 2.5694847 | 12 | 2.8984614 | 10 | 2 |
| floor7 | 0.8528066 | 24 | 0.2223188 | 22 | 2 |
| floor8 | 0.4104144 | 41 | 0.1116364 | 36 | 5 |
| floor9 | 0.9817976 | 20 | 0.3784892 | 18 | 2 |
| Lat | 49.0630434 | 2 | 61.8232036 | 2 | 0 |
| Lng | 42.5547900 | 3 | 50.3127812 | 3 | 0 |
| metro1 | 7.0376257 | 5 | 4.4084035 | 6 | -1 |
| principales | 100.0000000 | 1 | 100.0000000 | 1 | 0 |
| renovacionCondicion2 | 0.9027121 | 23 | 0.1474637 | 30 | -7 |
| renovacionCondicion3 | 2.9540355 | 10 | 2.1133413 | 11 | -1 |
| renovacionCondicion4 | 6.0375754 | 6 | 4.8813693 | 5 | 1 |
| seguidores | 23.5154818 | 4 | 30.0805975 | 4 | 0 |
EN ESTA TABLA DONDE ESTAMOS COMPARANDO LA IMPORTANCIA DE LAS VARIABLES ENTRE LOS 2 MODELOS MEJORES: RANDOM FOREST Y AUMENTO DE GRADIENTE, VEMOS QUE LAS PRIMERAS VARIABLES SON CASI LAS MISMAS PARA AMBOS: 1.-PRINCIPALES(TAMAÑO Y NÚMERO DE ESTANCIAS) 2.- Y 3.-LATITUD Y LONGITUD(SITUACIÓN GEOGRÁFICA DEL INMUEBLE EN LA CIUDAD) 4.-SEGUIDORES EN LA PÁGINA (5.-QUE HAYA METRO CERCA DEL INMUEBLE PARA RANDOM FOREST, Y QUE TENGA ASCENSOR LA FINCA PARA GBM) 6.-QUE EL PISO TENGA HECHA UNA BUENA REFORMA O NO
load("./traintest_prTotal.RData")
explainerRF<- DALEX::explain(
modelo_rf,
label = "RANDOM FOREST",
data = test_prTotal,
y = test_prTotal$totalPrice1,
verbose = FALSE
)
explainerGBM<- DALEX::explain(
modelo_gbm,
label = "AUMENTOGRADIENTE",
data = test_prTotal,
y = test_prTotal$totalPrice1,
verbose = FALSE
)mpRF <- model_performance(explainerRF)
mpGBM <- model_performance(explainerGBM)
plot(mpRF,mpGBM, geom = 'boxplot')
Vemos que los residuos son pequeños y muy parecidos entre ambos modelos.
vi<- model_parts(explainerRF, loss_function = loss_root_mean_square)
plot(vi)
Y aquí podemos ver el error cuadrático medio por variable.
CONCLUSIÓN
INTERPRETABILIDAD DEL MEJOR MODELO “RANDOM FOREST”:
Teniendo en cuenta toda la información anterior, si la prioridad es maximizar la capacidad predictiva del modelo, como primera opción se debería seleccionar el modelo de “random forest”.
El modelo basado en random forest es el que mejores resultados obtiene tanto en el conjunto de test como en la validación (repeated CV). Los modelos basados GBM y XGB consiguen valores de test muy similares.
Vemos que el modelo “RANDOM FOREST” tiene un nivel de R2 medio= 0.65, así que tiene una explicatividad del 65%. No es nada alto nuestro nivel de ajuste y explicatividad del modelo.
Puede haber pasado que en el proceso de construcción del modelo, el hecho de que hayamos sido muy efectivos en la limpieza de outliers, colinealidad, etc. estemos quitando en exceso un cierto grado de ruido necesario en el modelo para evitar un sobreajuste que posteriormente nos puede conducir a un bajo nivel de predicción en el conjunto de test.
maquetar(mod_rf$results %>% arrange(-Rsquared) %>% head(10)) %>%
add_header_lines(values = "Resultados entrenamiento del modelo Random Forest ordenados según valor del R2")Resultados entrenamiento del modelo Random Forest ordenados según valor del R2 | ||||||||
|---|---|---|---|---|---|---|---|---|
mtry | splitrule | min.node.size | RMSE | Rsquared | MAE | RMSESD | RsquaredSD | MAESD |
14 | variance | 5 | 0.3932020 | 0.6504825 | 0.2351972 | 0.02860972 | 0.04007672 | 0.008452444 |
13 | variance | 5 | 0.3948012 | 0.6484374 | 0.2370153 | 0.02798121 | 0.03938204 | 0.008192287 |
12 | variance | 5 | 0.3964389 | 0.6474424 | 0.2386585 | 0.02827250 | 0.04014519 | 0.008202766 |
11 | variance | 5 | 0.3987860 | 0.6449262 | 0.2410152 | 0.02653840 | 0.03708779 | 0.008102723 |
14 | extratrees | 5 | 0.4300250 | 0.5885064 | 0.2678760 | 0.02048415 | 0.02068966 | 0.007709120 |
13 | extratrees | 5 | 0.4325538 | 0.5853444 | 0.2702101 | 0.02060142 | 0.02003163 | 0.008160807 |
12 | extratrees | 5 | 0.4362643 | 0.5806498 | 0.2734250 | 0.02008255 | 0.01938413 | 0.007792220 |
11 | extratrees | 5 | 0.4412765 | 0.5735376 | 0.2777879 | 0.02030082 | 0.02014833 | 0.007909555 |
Alcanza el mejor ajuste con los hiperparámetros: MTRY=14 y MIN.NODO= 5.
IMPORTANCIA DE LAS VARIABLES:
plot(varImp(mod_rf))
LAS VARIABLES MÁS IMPORTANTES SEGÚN EL MODELO SELECCIONADADO COMO EL MEJOR AJUSTE SON: PRINCIPALES (RELACIÓN TAMAÑO Y NÚM. ESTANCIAS), LA UBICACIÓN GEOMÉTRICA DENTRO DE LA CIUDAD DE BEIJING (NO TIENE EL MISMO PRECIO UN PISO EN UN BARRIO QUE EN OTRO) Y EL NÚMERO DE SEGUIDORES DE LA TRANSACCIÓN. SEGUIDO CON DISTANCIA DE LAS VARIABLES METRO Y REFORMA DEL INMUEBLE.
**POR LO TANTO SON LAS VARIABLES MÁS IMPORTANTES QUE TENEMOS QUE TENER EN CUENTA A LA HORA DE SABER EL PRECIO DE UN INMUEBLE EN BEIJING: 1.-TAMAÑO (METROS CUADRADOS DE LA VIVIENDA), NÚMERO DE ESTANCIAS-HABITACIONES-SALONES. 2.-LA POSICIÓN GEOMÉTRICA EN LA CIUDAD. 3.-EL NÚMERO DE SEGUIDORES DE LA TRANSACCIÓN. CUANTO MÁS INTERESADOS HAYA EN EL INMUEBLE, MAYORES OFERTAS RECIBIRÁ EL VENDEDOR. 4.-SERVICIO DE METRO CERCA DEL INMUEBLE. 5.-LA REFORMA GRANDE O INTEGRAL QUE SE LE HAYA HECHO AL INMUEBLE.
NOTAS
La mayor dificultad que he tenido en el examen ha sido la falta de tiempo, para hacer más pruebas y poder hacerlo más completo. Al estar trabajando al mismo tiempo que estudio, esta vez he ido apurada.